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ABSTRACT 


Computer programming and analysis efforts during this three 
phase contract were carried out in support of the Earth Radiation 
Budget Experiment (ERBE) at NASA/Langley. The Earth Radiation 
Budget Experiment is described as well as data acquisition, 
analysis and modelling support for the testing of ERBE 
instruments. Also included are descriptions of the programs 
developed to analyze, format and display data collected during 
testing of the various ERBE instruments. Listings of the major 
programs developed under this contract are located in an 
appendix. 



SECTION 1 


INTRODUCTION 


Computer programming and analysis efforts during this three 
phase contract were carried out in support of the Earth Radiation 
Budget Experiment (ERBE) at NASA/Langley. The Earth Radiation 
Budget Experiment will be described in Section 2 of this 
report. Data acquisition, analysis and modelling support for the 
testing of ERBE instruments will be described in Section 3 of 
this report. In Section 4 will be found descriptions of the 
programs developed to analyze, format and display data collected 
during testing of the various ERBE instruments. Listings of 
major programs developed under this contract will be found in an 
appendix to this report. 




SECTION 2 


ERBE. 


The Earth Radiation Budget Experiment is designed to measure 
the energy reflected by and emitted by the whole Earth. Three 
separate satellites will be placed in orbit carrying. sets of 
instruments to measure the Earth's radiative "budget". The data 
collected during the lifetime of these satellites will facilitate 
a better understanding of our weather and climate on both a 
global and local scale. 

At the time of this report, two of the three satellites 
carrying ERBE instruments were already. in orbit. The first of 
these was ERBS (Earth Radiation Budget Satellite) launched from 
the Space Shuttle in October 1984. The second set of instruments 
was launched from Vandenburg Air Force Base in California aboard 
a TIROS near-polar orbital satellite in December, 1984. The 
third and final, set of instruments will be on another 
TIROS/Vandenburg launch in late 1985. It is hoped' that the three 
separate orbits achieved will give maximum coverage of the 
Earth's radiation budget in all areas of the globe. 

The ERBE instrument sets each include a Scanner instrument 
and a Non-Scanner instrument. The Scanner instrument has three 
detectors which are used to measure radiation in the long wave, 
short wave and total regions of the spectrum. The Non-Scanner 
instrument contains radiometers for medium field of view and wide 
field of view, each making, measurements in the long wave and 
total regions of the spectrum. The Non-Scanner also has an 
instrument called a Solar Monitor for measuring the Sun's 
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intensity. 

Calibration of highly sophisticated instruments like the 
ERBE Scanner and Non-Scanner is an important and demanding part 
of a successful scientific investigation. The ERBE instruments 
were designed to be self calibrating in orbit in order to take 
into account any gradual changes with time of the various 
instrument response functions. The Non-Scanner can be rotated to 
view space as a nearly zero source of radiation, and then rotated 
to face the Sun as a known very high level source. of radiation. 
The Scanner views space briefly during every four second scan to 
provide a zero reference. The Scanner also has the capability to 
view the sun through its Mirror Attenuator Mosaic (MAM) . The MAM 
reduces the intensity of the incoming radiation to a safe level 
which will not damage the Scanner detectors. Each instrument 
also has a blackbody radiation source for internal calibration. 
Taken together, these calibration sources provide a comprehensive 
means to assure the quality of all ERBE data telemetered to 
Earth . 
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SECTION 3 


DATA ACQUISITION, ANALYSIS AND MODELLING 


The design, fabrication and testing of the ERBE engineering- 
preflight- and flight-models required considerable use of 
computers. Radiometric and thermal modelling, data acquisition, 
recording and analysis are major areas of computer usage in the 
ERBE project. 

Radiometric and Thermal Modelling 

Radiometric and thermal modelling of the ERBE radiometers 
involved a number of programming efforts on different computers 
located within NASA/Langley and at the various instrument and 
satellite contractors' facilities. Support under this contract 
was given to several of these modelling efforts. Radiometric and 
thermal modelling software developed by Dr. Robert Mahan of 
VPI&SU was converted to a form. usable on the NASA/Langley CDC 
computer system. Thermal modeling efforts at TRW were augmented 
by the utilization of the Vector-Instruction-Set of the HP-1000 
computer system. Computer calculations which had taken as long 
as sixteen hours to perform were reduced to less than one minute 
without a loss of accuracy. 

Data Acquisition and Recording 

Data acquisition and recording software and facilities were 
provided by the instrument and satellite manufacturing 
contractors. During instrument testing, satellite integration 
and pre-launch satellite testing, support was given in monitoring 
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the acquisition and recording of data. Set-up and check-out of 
the HP-1000 computer at the Western Test Range (Vandenburg Air 
Force Base, California) was done in preparation for pre-launch 
testing of the TIROS/ERBE satellite. Support was given to the 
thermal-vac testing of ERBS (Earth Radiation Budget Satellite) at 
Ball Aerospace in Boulder, Colorado. SEPET (Spacecraft 
Electrical Performance and Evaluation Test) testing of the ERBE 
instruments at RCA's facilities in New Jersey was also 
extensively supported. Pre-launch testing of ERBS at Kennedy 
Space Center in Florida was carried out using the HP-1000 
computer to acquire data from the Ball computer system on a real- 
time basis. Off-line data. reduction was carried out to determine 
the status and performance of the ERBS instruments. 

Data Reduction and Analysis 

During the extensive testing of the three sets of ERBE 
instruments, several hundred magnetic tapes were filled with test 
data. Proper evaluation of these tests required the use of 
considerable software and computing facilities. TRW, the 
instrument fabricator, supplied a significant number of programs 
which were designed specifically to evaluate ERBE instrument test 
data. Under this contract, many additional programs were 
developed to augment the capabilities of the TRW software. These 
additional programs are described in the next section. Listings 
of some of these programs are included in the appendix. The vast 
majority of these programs were developed on an HP-1000 computer 
which was identical to the one used by TRW as .the BCU (Bench 
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Check-Out) computer during testing 


3-3 



SECTION 4 - SOFTWARE DEVELOPMENT 


In the early stages of testing of the ERBE instruments at 
TRW, all the test data collected was reduced and analyzed on the 
same HP-1000 (BCU) computers used to run the tests and record 
test data. Although a fairly large set of computer programs was 
written by TRW to analyze the data on the HP-1000 computers, 
demand for time on the computers exceeded time available. Many 
of the tests performed on the ERBE instruments were run 24 hours 
a day for many days. It was felt that the data could be analyzed 
on NASA's large CDC NOS computers if the data tapes could be 
reformatted into a CDC compatible form. An HP-1000 program 
called MAGAN was developed under this contract to perform the 
reformatting and other utility functions. Originally, MAGAN was 
used by TRW to generate CDC compatible tapes which were then 
shipped to NASA for analysis. Later modifications to MAGAN added 
options to extract calibration data, to generate and update 
history tapes and to calculate time/cycle data. MAGAN could also 
be used to generate a comprehensive summary of the data on these 
tapes. On NASA’s CDC - NOS computers a program called ERBDAT was 
designed to tabulate test data for both scanner and non-scanner 
instruments from these MAGAN reformatted data tapes. 

Even though ERBDAT helped in the tabulation of ERBE test 
data, it soon became apparent that the use of an additional HP- 
1000 computer complete with the plotting and analysis software 
developed by TRW was needed. NASA/Langley acquired the use of an 
HP-1000 and work was begun on a system generation which would be 
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compatible with the systems on the three HP-1000 BCU computers at 
TRW. TRW's programs such as MTAPE, GNPLT, PLTMS, ERBDR, NSPLT 
were installed on the new HP-1000. Constant access to an HP-1000 
made it possible to write additional programs which could augment 
those provided by TRW. CATLG was written to catalog the data 
records and SUMRY was written to supply time-listings of major 
frames, command echoes and status words. MAP was written to 
tabulate the timing of the ERBE data samples. INST was written 
to tabulate instrument data files extracted by the MTAPE 
program. Numerous improvements were made to the overall set of 
ERBE data reduction and analysis programs. 

As the sets of ERBE instruments were readied for shipment to 
the satellite manufacturing facilities at RCA (ERBE/TIROS) and 
Ball Aerospace (ERBS), a new urgent need for software 
developed. During satellite integration many new test data tapes 
were produced. These data tapes were in totally different 
formats from the data tapes generated at TRW. In order to 
utilize the considerable software developed under this contract 
and by TRW, additional programs had to be developed to convert 
the data in these new formats back into a format usable by the 
existing software. 

TIP was the first of these conversion programs written to 
convert TIP (Tiros Information Processor) data to TRW ERBE 
format. The TIP data was blocked in records of 1024 words. Of 
these 1024 words, only a small number of words were extracted to 
generate 10 minor frames of data. When 320 consecutive minor 
frames were assembled, a major frame was generated and written to 
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tape. Differences in the analog-to-digital converters in the 
TIROS satellite required changes in the data being written to the 
TRW formatted tapes . 

PCM was a program designed to convert ERBS data tapes 
created at Ball Aerospace into TRW-PCM form (Pulse Code 
Modulated). A program called ALL was also written to generate. 
TRW-PCM data tapes from ERBS All-Experiment formatted tapes. 

Under some testing conditions at the satellite manufacturing 
facilities and at launch facilities, it was not always possible 
to have an HP-1000 computer handy. Utility programs were 
developed under this contract to run on portable Radio Shack TRS- 
80 Model 100 computers. These programs were useful in decoding 
command echoes, status words and in calculating position data. 
Program options also included capabilities to construct command 
sequences which could later be issued by the test conductors to 
the spacecraft. 
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APPENDIX 


PROGRAM LISTINGS AND USER NOTES: 


MAGAN 


SUMRY 


TIP 


PCM 


ERB 


Page 


A- 2 


A-32 


A- 3 9 


A-47 


A-53 


MAGAN 


MAGAN is used to analyze ERBE test data tapes using the HP- 
1000 BCU computer. To use MAGAN, simply mount a tape to be 
analyzed on either tape drive (LU 8 or 9) and then type MAGAN on 
the consol. MAGAN responds with a menu of options. Choose the 
desired option and proceed to answer any questions the program 
may ask . 

OPTIONS 

1. Tape to Disk, Reformat to New Tape 

Option one was designed to overcome the problem of 
reformatting a tape with only one tape drive. The tape is 
first copied to disk and then reformatted as it is written 
to the new tape. Reformatting in this case is to CDC-NOS 
format from TRW format. Tapes generated with this option 
can only be processed on CDC computers. 

2. Tape to Tape With Reformatting 

This option is the same as option one except it takes 
advantage of a system with two tape drives. 

3. Reformat and Write Disk to Tape 

After data has been copied to disk using some other 
option (such as option 1), this option will copy the data 
file from disk to a new tape. Multiple copies of the same 
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file can be created this way. The data is formatted on the 
tape in CDC format. 

4. Catalog of Events 

Mount a test data tape and this option will produce a 
listing of all the TRW test commands and comments recorded 
on the tape. Such a listing can prove to be very useful in 
locating the beginning of a calibration or test procedure. 

5. Calculate Time/Cycle Data 

This option is used to calculate "on time" and the 
number of cycles (on-off transitions) of the various 
"digital B" parameters. Digital B data is bilevel data 
which indicates which pulse load bus is in use, when the 
azimuth and elevation motors are on, etc. 

6. Comprehensive Summary 

This option generates a full report of the various 
types of commands, comments and error messages logged to a 
test data tape. 

7. Change List Device 

This enables a choice between printer or CRT (screen) 
for output of the program. 

8. Rewind Tape 

Program will rewind data tape. 


A- 3 



9. Position Mag Tape Forward One Record 

A useful option to position the tape beyond a trouble 
spot, such as an unexpected end-of-file. 

10. Copy Disk to Tape With No Reformatting 

This is used to make exact duplicates of test data 
tapes . Tapes generated with this option are usable only on 
the HP-1000 computer. 

11. Enter Available Disk Cartridge Numbers 

During tape copying to disk, considerable disk space is 
required. This option allows the user to select how much 
room on the disk he is willing to use to copy the tape. 

12. Change Mag Tape Logical Unit 

In a multiple tape unit system, this option allows 
either tape unit to be designated for use. 

13. Update an Operating History Tape 

After appropriate data has been selected for addition 
to the Operating History Tape, this option will append the 
records to the history tape. 

14. List Contents of Operating History Tape 

Lists the contents of the history tape to the printer. 
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15. Extract Cal Data and Update Cal History Tape 

Extracts calibration data and updates Cal History Tape. 

16. List Contents of Calibration History Tape 

Provides hardcopy of Cal History Tape. 

17. Exit MAGAN 
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4'. 19 PM WED., 23 JAM., 1935 


2 *EMA<XY2,0> 

3 C 

4 C 

5 C 

6 C NAME: MAGAN 

7 C MODULE: PROGRAM 

8 C AUTHOR: W. EDMONDS, NASA LANGLEV <304> 827-3761 

9 C REV DATE: <830323.1 611 > 

IOC 

11 C PURPOSE: 

12 C 

13 C 

14 C MAGAN IS USED TO ANALYZE MAG TAPES PRODUCED WHEN TESTING 

15 C TIROS INSTRUMENT TAPES ON THE TRW BCU . MAGAN PROVIDES 

16 C A MENU OF CAPABILITIES: 

17 C 

18 C 1 = Tape to Disk, Reformat to New Tape 

19 C 2 = Tape to Tape, Reformat 

20 C 3 = Reformat and Write Disk to Tape 

21 C 4 = Catalog of Events 

22 C 5 = Calculate Time/Cycle Info 

23 C 6 = Provide Comprehensive Summmary of Tape 

24 C 7 = Change List Device 

25 C 8 = Rewind Mag Tape 

26 C 9 = Position Mag Tape Forward by 1 Record . 

27 C 10 = Copy Disk to Tape as is < No Ref ormatt ing ) 

28 C 11 = Enter Available Disk Cartridge Numbers 

29 C 12 = Change Mag Tape Logical Unit # 

30C 13 = Update an Operating History Tape 

31 C 14 = List the Contents of an Operating History Tape 

32 C 15 = Extract Cal Data from TRW Data Tape and Update Cal History Tape 

33 C 16 = Provide hardcopy summary of contents of Calibration History Tape 

34 C 17 = Exit 

35 C 

36 C Enter a command: 

37 C 

38 C 

39 C 

40 PROGRAM MAGANC >,<830323. 161 1> 

41 C 
1 42 C 

43 C 

44 INTEGER MAG0C3) ! NAME OF 1ST SEGMENT 

45 INTEGER LBUF<1G0> ! USED FOR LARGE BUFFER SUBROUTINE LGBUF 

46 C 

47 C 
43 C 

49 COMMON /XYZ/ STVALU< 2, 8 1 93 > 

50 COMMON /BUF/ IDCB<144), IBUF<3938>, IERR, LEN, IREC, HR, 

51 + ICAR, NAM< 3 ), ISIZ<2>, LUL, I FIR, ILAS, JTYPE, 

52 + ID, INST, MTFL, IVDF, ITEST<6,2>, IC0ND<3,2>, 

53 + N0SER< 2,2), N0YR<2>, NQDAY< 2 >, IREELC2), N0HR<2>, 

54 + NQMIN< 2 ), N0SEC<2), M0SEC<2>, NCAR, IFCAR, LCAR, 

55 + ISTAF< 2 ) , MTLU, LUNUM< 2 > 

56 C 
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NAG AN OPTS: 


LVi 


AGE 2 


4 : j 9 PM 'WED-. , 23 JAN,, 1985 


57 C 

58 C 
55 
60 
61 
62 

63 C 

64 C 

65 C 

66 

67 C 
63 C 
69 C 
7 0 

71 

72 


COMMON /'DIGB7 

+ 

+ 

+ 


ISC0D<3, 12), INC0D<3,12>, ISDES< 20, 12), 

INDES< 20,12), ONT < 12,2), 

IDIG< 2 ), I C C B < 144), ICNhM<3>, JSIZ<2), 

I DAY< 12,2), JDAY 


DATA MAGO 7 'MAGO ' / 


LUT - LOGLLK IDUM ) 

CALL LGBUF< LBUF, 100) 
CALL SEGLDCMAGO, IRTN ) 
END 


FTN4X COMPILER: HP92834 REV. 2130 <810716) 


+* NO WARNINGS +* NO ERRORS *+ • PROGRAM: 130 COMMON: < NONE > 
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OPTS: 


LYI 


4:19 PM WED,, 23 JAN. 


1985 


FTN. 


. 74 C 

75 C 

76 C 

77 C 

78 

79 C 

80 C 

31 C 

32 

33 

34 C 

35 C 

36 C 
87 
33 
39 

90 C 

91 C 

92 C 

93 

94 

95 

96 

97 
93 
99 

1 00 
101 
1 02 
1 03 
1 04 
1 05 
1 06 
1 07 
1 08 
1 09 
1 1 0 
1 1 1 
1 12 
1 13 
; 114 
1 15 
1 16 
1 17 C 
1 13 C 
1 19 C 
120 
121 
122 

123 

124 

125 
1 26 
127 
123 


+ * + ***♦**•+ + -1e***H< + .+ ** + * + + + + + •+ *.+ ** + *. + * + .+ * + + * + + * + * + .+ * ******* 

SUBROUTINE R6TIM< IBUF , I T I ME , I RTN > , READ THE ASCII TIME & CONVERT 


INTEGER IBUF<1J, ITIME< 1 J 
INTEGER DAYMON< 12), NAMN0M<2,12J 


DATA DAVMON / 31, 23, 
DATA NAMMON / ' JAN', 
+ ' JUL', 


31, 30, 
' FEB', 
' AUG', 


31, 30, 
' MAR', 
' SEP', 


31 , 31 , 
' APR', 
' OCT', 


30, 31, 
' MAY', 
' NOV', 


30, 3 1 / 

' JUN', 

' DEC' / 


I RTN = 0 

I HR = 1 0*< IAND< 177400B, IBUF< 52 J J/256 - 6 OB J + 

+ IANDC377B, IBUF<52JJ - 60B 

IF <<IBUF<5SJ .EQ. 2HPM J .AND, < IHR .HE, 12 JJ THEN 
IHR = IHR + 12 

ELSE IF <<IBUF<53J . EQ . 2HAMJ .AND. < IHR . EQ . 12 J J THEN 
IHR = 0 
END IF 

IF < < IHR . LT . OJ .OR. < IHR . GT . 23 J J THEN 
IRTN = -1 
GOTO 1000 
ENDIF 

MINUT = 1 0*< I AND< 377B, IBUF< 53 J J - 60BJ + 

+ IAND< 177400B, IBUF<54J J/256 - SOB 

IF < < MINUT .LT. OJ .OR. <MINUT .GT. 59JJ THEN 
IRTN = -1 
GOTO 1000 
ENDIF 

ISEC = 1 0*< IAND< 1 7740 OB, IBUF< 55 ) J/256 - 6 OBJ + 

+ IAND<377B, IBUF<55 J J - 60B 

IF < < ISEC .LT. OJ .OR. < ISEC .GT. 59JJ THEN 
IRTN = -1 
GOTO 1000 
ENDIF 


IDAYNM = 1 Q+< IAND< 377B, IBUF< 62 J J - 60BJ + 

+ IAND< 177400B, IBUF< 63 J J/256 - 60B 

IF << IDAYNM .LT. 1J .OR, < IDAYNM . GT . 31 JJ THEN 
IRTN = -1 
GOTO 1000 
ENDIF 

I YEAR = 1900 + 1 0*< IAND< 177400B, IBUF<64J J/256 - 60BJ + 
+ IAND< 377B, IBUF< 64 J J - SOB 

DO 100 I = 1,12 
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R6TIM 


<jAN . , i 985 


129 IF < < IBUF< 60 ) . EQ . NAMMGH<1>I>) .AND. 

130 + < IBUF< 61 ) . EQ . NAMMGN< 2, I ) ) > THEN 

131 GOTO 120 

132 END IF 

133 100 CONTINUE 

134 120 MONTH = I 

135 IF < MONTH . EQ . 1) THEN 

136 IDAY •= IDAYNM 

137 GOTO 155 

133 END IF 

139 IDAY = 0 

140 DO 150 I = 1 , MONTH- 1 

141 IDAY = DAYMON<I) + IDAY 

142 150 CONTINUE 

143 IF < < MOD< I YEAR , 4 > . EQ . 0) .AND. < MONTH .GT. 2 > > THEN 

144 IDAY = IDAY + 1 


145 
1 46 


ENDIF 

IDAY = IDAY 

+ IDAYNM 

1 47 

155 

I T I ME< 1 ) 


0 

1 48 


I T I ME< 2 ) 

= 

ISEC 

1 49 


I T I ME< 3 ) 

= 

MI HUT 

150 


ITIME< 4 ) 

s 

I HR 

151 


ITIME< 5 ) 

s 

IDAY 

152 


I T I ME< 6 ) 

= 

I YEAR 

153 

1 000 

RETURN 



154 


END 




FTN4X COMPILER: HP92834 REV, 2 130 <810716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 330 COMMON: < NONE ) 
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155 C 

156 C ’ + + + + + + + + + + + * + + * + + + + 

157 C *.+ *:'HH*.1t.+ .+ .+ + -i«H<*.+ *-i5H«.+ + + .+ +.+ + + + + + + + :f<*.+ * + **'h + + :** + * + + ** + + * + :k*:4<.+ 

1 53 C 

159 SUBROUTINE SUBTM< CURTM, SBTIM, NUTIM, IRTH ), REV HC 11-19-81 BY DHL 

160 INTEGER CURTM<6), SBTIMC6), NUTIM<6>, IMAX<6) 

161 INTEGER DMTIM<6> 

162 C 

163 C 

164 C 

165 DATA IMAX/1 00, 60, 60, 24, 365, 0/ 

166 C 

167 C 

168 C 

169 DO 100 I = 1,6 

170 DMTIfK I > = CURTM< I ) 

171 100 CONTINUE 

172 DO 500 1=1,6 

173 NUTIM<n = DMTIMU) - SBTIM< I) 

174 IF < HUTIf'K I ) , GE . 0) GO TO 500 

175 C 

176 C MUST BORROW - PERHAPS MORE THAN ONCE. 

177 C 

178 NUTIM<I> = NUTIM< I ) + IMAX< I > 

179 DO 300 J =. 1 + 1 ,6 

180 IF <J .EQ. 6 ) GOTO 600 

181 DMTIM< J ) = DMTIfK J ) - 1 

182 IF < DMTIM< J > .GE. 0) GO TO 500 

133 DMTIMCJ) = DMTIM< J ) + IMAX<J) 

134 300 CONTINUE 

135 500. CONTINUE 

136 DO 550 N = 1,6 

187 550 IF < NUTIM< N ) .LT. 0) GOTO 600 

188 IRTN = 0 

139 RETURN 

1 90 C 

191 C ERROR - CAN'T SUBTRACT GREATER TIME FROM LESSER TIME 

192 C 

193 600 IRTN = -1 

194 RETURN 

, 1 95 END 


TH4X COMPILER; HP92834 REV. 2130 <310716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 143 COMMON: < NONE > 
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FIN , 


UP I s : 


wtu . 


Jan , , i 985 


196 C 
19? c 

198 C 

199 C 

200 
201 C 
2 02 C 

203 C 

204 

2 05 C 
2 06 C 
20? C 
208 

209 

210 


*:************** ****:**+***#:* + *** + *##**:*** + + + : **+ + + + + *;* + * 

SUBROUTINE HOURS< I TIME, EH OUR > 


INTEGER ITIMEC1) 


EHOUR = ITIME( 4 > + ITIME< 5 )*24 . + ITIME<3V6Q. + ITIME< 2 V3600 . 

RETURN 

END 


FTN4X COMPILER: HP92834 REV. 21 30 <810716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 65 COMMON: < NONE ) 
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211 C 

212 C 

213 C 

214 C 

215 

216 C 

217 C 
213 C 

219 

220 C 

221 C 

222 C 

223 

224 

225 100 



+ ifc :t( * + + *+ :4e .-+c r+c :+c + + +. :-fc + :4t .+: :-H + # + * * H« # + :<e * + * + :4< + H< + * 

»♦* .+ * =4* He .i« :4« * % + :4t * * Ht * + * * + * + * * * * * ♦ + * + H« + * * * + + + * + + * + * * * H* * + + * + + :+c :4c :4c 


SUBROUTINE PUTTMC FRTIM1 ,T0TIM2> 


INTEGER FRTIMK1), T0TIM2< 1 > 


DO 100 I = 1,6 

TOT I M2< I > = FRTIMK I > 

CONTINUE 

RETURN 

END 


FTN4X COMPILER: HP92834 REV. 2130 <810716) 

** NO WARNINGS *+ NO ERRORS ** PROGRAM: 31 COMMON: (NONE) 
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223 C 

229 C 

230 C 

231 C 

232 

233 C 

234 C 

235 C 

236 

237 
233 

239 

240 

241 

242 C 

243 C 


* + * * * * * * * + * * * * * * + * * * * * * * * * * % * * * * * * + * * * * * * * * + * * * * * * * * * * * * * 
********************************************************* 

SUBROUTINE COPKKBUF) 


COMMON 7BUF7 IDCB(144), IBUF(3933>, IERR, LEN, IREC, HR, 

+ ICAR, NAM< 3 ), 1312(2 >, LUL, IFIR, ILAS, JTYPE, 

+ ID, INST, MTFL, IVDF, ITEST(6,2>, IC0ND(3,2>, 

+ NOSER< 2,2), NOYR( 2 ) , NQDAY< 2 ), IREEL< 2 ), N0HR<2), 

+ NOMIN< 2 ), NOSEC< 2 ), M0SEC<2), NCAR, IFCAR, LCAR, 

+ ISTAF< 2 >, MTLU, LUNUM< 2 > 


244 C 

245 

246 

247 C 
243 C 
249 C 


DIMENSION I DC< 144), KFORM< 4 ) 

+ , KBUFC 24 0 0 > , I FOR< 7 ) , I F I V< 4 > , NFORMC 4 > , MFORMC 2 ) 


250 

DATA 

IFOR 7 

'< 13, 13, El 4 

.8) 

251 

DATA 

IFIV 7 

'( 3E1 2 . 6 ) ' 

7 

252 

DATA 

NFORM 7 

'<48006 >' 

7 

253 

DATA 

KFORM 7 

'(80006 >' 

7 

254 

• DATA 

MFORM 7 

'<16)' 7 



255 C 


256 C 

257 C 
253 

259 

260 
261 
262 

263 

264 

265 

266 
267 
263 

269 

270 

271 

272 

273 

274 

275 

276 

277 


LUT = LOGLU(IDUM) 

WRI TE< LUL, 910 0) 

MTALT = 0 

CALL OPENF< I DC, I ERR, MTLU ) 

IF (I ERR .LT. 0) THEN 
25 IdRI TE< LUT, 91 10) IERR 

GOTO 5000 
ENDIF 

IFC = IFCAR 
LC = LCAR 

35 URI TE< LUT, 91 20 > 

READ< LUT, 9t22 > IANS 
IF < < IANS .NE. 2HYE) .AND. (IANS 
IF ( IANS .EQ. 2HYE) THEN 
40 URITE< LUT, 91 25 > 

READ(LUT,*> IDUM 
IF ((IDUM .LT. 1 > .OR. ( IDUM 
MTALT = IDUM 
LC = IFCAR 

ELSE 


.NE, 2HN0 ) ) GOTO 35 


.GT. 63 > ) GOTO 40 


278 GOTO 50 

279 ENDIF 
230 C 

281 C ***** WHEN MTALT IS NOT 0, THEN THIS IS TAPE TO TAPE COPY. 

232 C ***** THIS INDICATES THAT THE DO 10 LOOP BELOW WILL ONLY 
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283 

234 

235 

236 

237 
233 

289 

290 

291 

292 

293 

294 

295 

296 

297 
293 

299 

300 

301 

302 

303 

304 

305 

306 

307 

308 
3 09 
31 0 
31 1 

312 

313 

314 

315 

316 

317 
313 

319 

320 

321 

322 

323 

324 

325 

326 

327 
32S 

329 

330 

331 

332 

333 

334 

335 

336 

337 


C 

C 

C 

C 

C 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 


***** MEED TO BE EXECUTED ONCE. THEREFORE LC = IFC = IFCAR . 
*+*** WHEN MTALT = 0, THEN THIS IS COPY FROM DISK TO TAPE. 
***** SINCE THE DISK FILE NAY OCCUPY MORE THAN ONE CARTRIDGE, 
***** IT IS NECESSARY TO LOOP THROUGH THE CARTRIDGES. 

CALL OPENF< IDCB, IERR, MTALT) 

IF < IERR . LT . 0) THEN 
URI TE< LUT, 913 0) I ERR 
GOTO 5000 
ENDIF 
LINE =0 

50 DO 1000 JCAR = IFC,LC 

IF < MTALT .EQ, 0) CALL OPEfK IDCB, IERR, NAM, 0, 0, JCAR > 

IF < IERR .LT. 0) GOTO 25 
65 CALL READS 

IF < LEN . LE . 0) GOTO 550 
IF < IERR .LT. 0) THEN 

WRITE<LUT,9140) IERR, LEN 
GOTO 550 
ENDIF 

IF < I BUF .EQ. 0) GOTO 4000 

***** RECORD TYPE 0 INDICATES END OF INFORMATION. 

IF < I BUF .EQ. 1 ) THEN 
***** INSTRUMENT DATA. 

IF < I VDF .EQ. 0) GOTO 65 

***** THE VALID DATA FLAG IS SET TO ZERO FOR ALL INCOMPLETE 
***** MAJOR FRAMES BY SUBROUTINE READS. 

CALL HEADR<I<BUF<2 ), 1 ) 

LINE = LINE + 1 
IF < LINE . GT . 52) THEN 
LINE =0 
WR I TE< LUL, 9 1 00) 

ENDIF 

I VDF = IBUF< IND< 2,7)) 

IF < I VDF .NE. 1 ) GOTO 65 
ENCODE< 2 , 9 1 50 , KBUF ) IBUF< 1 ) 

CALL ENC< 6 , KBUF< 67 ) , LEN , t , 1 ,MF0RM,2) 


DO 180 LLL = 68,70 
KBUF< LLL ) = 2H 
ISO CONTINUE 

***** THE LAST 3 STATEMENTS WERE ADDED TO FILL ANY EVEN MULTIPLE 
***** OF 10 LOCATIONS IN KBUF. EVERY 10 LOCATIONS IN HP YIELDS 
***** 2 WORDS ON CDC MACHINES. OK? 

CALL WRITF< IDC/IERR, KBUF, 70 ) 
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333 

339 

340 

341 C 

342 C 

343 C 

344 

345 

346 
34? 
343 

349 

350 

351 

352 

353 

354 

355 

356 

357 
353 

359 

360 

361 

362 

363 

364 

365 C 

366 C 

367 C 
363 

369 C 

370 C 

371 C 

372 

373 C 

374 C 

375 C 

376 

377 
I 378 

379 

330 

381 

332 

333 

384 

385 
336 

387 

388 

389 

390 

391 C 

392 C 


IF < IERR . EG . -12) CALL NTAPEC IDC, IERR, KBUF, 70,8) 

IF < I ERR .LT. 0> GOTO 25 
IF < I BUF< 2 ) .EQ. 0) GOTO 300 

***** GOTO 300 TO PROCESS NON SCANNER 

ILEN = LEN - 479 
IF < LEN .NE. 3938) GOTO 65 
DO 200 N = 99, ILEN, 480 
M = N + 479 

CALL ENC< 2880 , KBUF , IBUF, N , M , NFORM , 4 ) 

CALL URITF< IDC, IERR, KBUF, 1440) 

IF < IERR ,EQ . -12) CALL NTAPEC I DC , I ERR, KBUF, 1 44 0, 3 ) 
IF < IERR .LT. 0) GOTO 25 
200 CONTINUE 
GOTO 65 
300 CONTINUE 

ILEN = LEN - 799 
IF C LEN .NE. 1642) GOTO 65 
DO 400 N = 43, ILEN, 800 
M = N + 799 

CALL ENCC 4300, KBUF, IBUF, N,M,KFORM, 4) 

CALL WRITFC IDC, IERR, KBUF, 2400) 

IF < I ERR .EQ. -12) CALL NTAPEC IDC, IERR, KBUF, 2400, 8 ) 
IF < IERR .LT. 0) GOTO 25 
400 CONTINUE 
GOTO 65 


ELSE IF C IBUF . EQ . 2) THEN 
***** PROCESS AMON DATA HERE. 

NC « I BUFC 8 ) 

***** GET # OF CHANNELS IN THIS RECORD OF AMON DATA 

ENCODE<30, 9180, KBUF) <IBUF<I),I = 1,3) 

DO 500 J = 1 , NC 
L = 9 + < J-1 )*4 
K = 16 + < J-1 )*1 0 
M = L + 3 

CALL ENC< 20, KBUF< K ), IBUF, L,M, IFOR, 7) 

500 CONTINUE 

K = NC* 10+16 
L = L + 4 
M = L + 18 

CALL ENC< 36, KBUF< K ), IBUF, L,M, IFIV,4) 

CALL WRITF< IDC, IERR, KBUF, K+17) 

IF < IERR .EQ. -12) CALL NTAPEMDC, IERR, KBUF, K+1 7, 3 ) 
IF < IERR .LT. 0) GOTO .25 
GOTO 65 
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393 C 

394 ELSE 

395 C 

396 C ***** PROCESS ALL RECORD TYPES EXCEPT AMON & DIG A 
39? C 

398 ENCODE* 2,9150, I CODE ) I8UF< 1 ) 

399 IBUF*1) = ICODE 

400 CALL URITF* I DC, I ERR, IBUF, LEN ) 

401 IF * IERR .EQ. -12) CALL NTAPE* IDC, IERR, IBUF, LEN, 8 ) 

402 IF < IERR .LT. 0) GOTO 25 

4 03 GOTO 65 . 

404 ENDIF 

405 C 
4 06 C 

407 C 

408 550 IF < MTALT .NE. 0) CALL RWNDF*IOCB> 

409 CALL CLOSE* IDCB) 

410 1000 CONTINUE 

411 4000 CALL EXEC* 3 , MTLU+ 1 0 OB ) 

412 CALL EXEC* 3, MTLU+ 1 0 OB ) 

413 ' CALL RUNDF* IDC ) 

4 1 4 C 

415 C 

416 C 

417 5000 RETURN 
413 C 

419 C ***** FORMAT STATEMENTS 

420 C 

421 91 00 FORMAT* " 1 ",/,T2, "TEST" , T14, "TEST" , T22, "SERIAL" , T57, "DECIMAL", 

422 + T65, "MAJ", T72, "TAPE" , T80, "REEL", T85, "IN" ,T90, "DATA" , 

423 + T95, "INSTR" ,T1 01 , "STN" , /, 

424 + T2, "PROCEDURE" ,T14, "COND. ",T22, "NUMBER", T32, "TIME", 

425 + T.47, "DATE", T57, "TIME", T65, "FR #",T72,"REC #",T80,"#", 

426 + T35, "VAC" , T90, "OK" , T95 , "TYPE" , T1 01 , "ID",T1 07, "DIST", 

427 + T 1 16, " AZ PGS" , T1 26, "EL POS" ,2/) 

428 9110 FORMAT*/, "FMGR ERROR # ",.I4," ON MAG TAPE OPERATION") 

429 9120 FORMAT*/, "Do you want to Copy from the Source Tape Unit to ",/, 

430 + "the Destination Tape Unit? *YES or NO): ) 

431 9122 FORMAT* 1 A2 ) 

432 9125 FORMAT* /, "Enter the Logical Unit # of the Source Tape Unit: _" ) 
1433 9130 FORMAT* /"FMGR ERROR # ",I4," ON DESTINATION TAPE UNIT") 

434 9140 FORMAT*/, "FMGR ERROR # ",I4," RECORD LENGTH = ",I5) 

435 9150 FORMAT* 12) 

436 9180 FORMAT* 12,614, I2,2X) 

437 END 


-TN4X COMPILER; HP92834 REV. 2130 *810716) 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 1 1 52 COMMON: * NONE ) 
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43S C 

439 0 *******:r*********** * + ** + *** + * + rtcft.'iC'ft* ************** ******** 

440 0 ********************************************************* 

441 C 

442 SUBROUTINE NTAPE< IDC, IERR,KBUF, LEN, LUL ) 

443 C 

444 C 

445 C 

446 DIMENSION IDC<144), KBUFC24Q0) 

447 C 
443 C 

449 C 

450 LUT = LOGLUCIDUM) 

451 URITE<LUT,91 GO) 

452 CALL RUNDF< IDC ) 

453 CALL CLOSE< IDO 

454 1 00 URITE< LUT, 9120) 

455 READ< LUT, 9150) IANS 

456 IF < IANS .EQ. 2HG0 ) GOTO 200 

457 WRITE< LUT, 9140) 

453 READC LUT, 9150) IANS 

459 IF < IANS .EG. 2HYE ) THEN 

460 CALL EXEC< 6 ) 

461 ELSE 

462 GOTO 100 

463 END IF 

464 200 CALL OPENF< IDC, IERR,LUL) 

465 CALL WRITF< IDC, IERR , KBUF, LEN > 

466 RETURN 

467 C 

463 C ***** FORMAT STATEMENTS 

469 C 

470 9100 FORMAT< /, "End-of-Tape on Mag Tape - after Mag Tape rewinds,”,/, 

471 + "Mount Continuation Tape!") 

472 9120 FORMATC/, "Enter GO when ready: _" ) 

473 9140 FORMAT < / , "Do you want to abort? <YES or NO): _" ) 

474 9150 FORMAT< 1 A2 ) ’ 

475 END 


FTN4X COMPILER: HP92834 REV. 2 130 <810716) 

*+ NO WARNINGS ** HO ERRORS ** PROGRAM: 193 COMMON: < NONE ) 
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C 

C +***• +********:{<**.+ + + .+.•<« + ******.+ ******. •<<:+! *•+**:+:*.■ *.+ **** + + * + :■(!** + 

C + **:***#**** + . it * + *****:*:****.+ *** + + * + ********* + ** ************ 

c 

SUBROUTINE MSTORs' I DC , I P ) 

C 
C 
C 

COMMON 

+ 

+ 

+ 

+ 

+ 

C 

c 
c 

INTEGER*4 ITLEN, IBLEN 
C 
C 
C 

DIMENSION IPO), IDC< 1 44 ) 

C 

C . 

C 

. DATA ITYP/3/ 

C 

C • 

C 

LUT = L0GLU< IDUM ) 

IREC =0 
NCAR = 0 
C 

C ***** NCAR COUNTS THE NUMBER OF CARTRIDGES USED TO HOLD DATA FILE. 
C 

JERR =0 
ITLEN = 0 
LINE =0 
IBLEN =0 
WRITE<LUL,91 00) 

CALL 0PENF< IDC, IERR, MTLU ) 

IF < IERR .LT. 0) THEN 
WRITER LUT ,9110) IERR 
GOTO 5000 
ENDIF 
C 

C ***** FOR EACH CARTRIDGE . . . 

e 

DO 1000 IC = IFCAR, LCAR 
CALL PURGEC IDCB, IERR, NAM, 0, IC) 

CALL CREAT< IDCB, IERR, NAM, ISIZ, ITYP, 0, IC) 

IF < IERR .LT. 0) THEN 
WRITE< LUT ,9120) IERR 
GOTO 5000 
530 ENDIF 


/BUF/ IDCBC144), IBUFs'3933), IERR, LEN, IREC, HR, 

ICAR, NAM< 3 ), ISIZ< 2 ), LUL, IFIR, ILAS, JTYPE , 

ID, INST, MTFL , IVDF, ITEST<6,2), IC0ND<3,2), 
N0SER< 2,2), NO YR< 2 ) , NODAYC 2 > , IREELC 2 ), N0HRC2), 
N0MIN< 2 ), NGSEC< 2 ), MOSECs'2), NCAR, IFCAR, LCAR, 

I STAF( 2 ) , MTLU, LUNUMC 2 ) 
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531 

532 

533 

534 

535 

536 

537 
533 

539 

540 

541 

542 

543 

544 

545 

546 

547 
543 
549 
55 0 

551 

552 

553 

554 

555 

556 

557 

558 

559 

560 

561 

562 

563 

564 

565 

566 

567 
563 

569 

570 
< 571 

572 

573 

574 

575 

576 

577 

578 C 

579 C 

580 C 


NCAR = NCAR + 1 

125 IF < JERR . NE . -33 > CALL READFC IDC, IERR, IBUF, 3938, ILEN > 
IF C IERR .EQ. -5) GOTO 125 
LEN = ILEN 

IF C C ILEN , LT . 0) .OR. C IERR .LT. 0)) GOTO 1200 
CALL URITFC IDCB , JERR, IBUF, ILEN) 

IF C JERR .EQ. -33) GOTO 200 
IF < JERR .LT. 0) THEN 
UR I TEC LUT, 91 30 ) JERR 
GOTO 1200 
ENDIF 

IF < ILEN .LT. 0) GOTO 1200 
ITLEN = ITLEN + ILEN 

IF < ILEN .GT. 200) IBLEN = IBLEN + ILEN 
IREC = IREC + 1 
LEN = ILEN 

IF C IBUF .EQ. 1 ) THEN 
HR = TIMEC IBUFC 3 ) ) 

CALL HEADRC IP, 0) 

LINE = LINE + 1 
GOTO 175 
ENDIF 

IF C IPC IBUF) .EQ. 1 ) THEN 

URITEC LUL, 91 40 ) <IBUF<K),K = 2, LEN) 

LINE = LINE + 1 
ENDIF 

IF CLINE . GT . 52) THEN 
LINE = 0 
UR I TEC LUL, 9100) 

ENDIF 

175 IF C JERR . GE . 0) GOTO 125 
GOTO 1100 

200 CALL CLOSEC IDCB ) 

1000 CONTINUE 

URI TEC LUT, 9150) 

GOTO 1300 

1100 UR I TEC LUT, 9110) JERR 
1200 IBUFC 1 ) = 0 
ILEN = 1 

CALL URITFC IDCB, IERR, IBUF, ILEN) 

IF C IERR .LT. 0) UR I TEC LUT, 91 60 ) IERR 
CALL CLOSEC IDCB) 

1300 WRITECLUT,9170> IREC, ITLEN, IBLEN 
UR I TEC LUL ,9170) IREC, ITLEN, IBLEN 
CALL RUNDFC IDC) 

CALL CLOSEC IDC) 

5000 RETURN 

***** FORMAT STATEMENTS 


581 

582 

583 

584 
535 


9100 FORMATC " 1",7,T2, “TEST", T 14, "TEST" , T22, "SERIAL" , T57, "DECIMAL", 
+ T65, "MA J" , T72, "TAPE” , T30, "REEL" , T85, ”IN",T90, "DATA", 

+ T95, " INSTR" , T1 01 , "STN" , 7, 

+ T2, "PROCEDURE" ,T1 4, "COND . " , T22, "NUMBER" , T32, "TIME" , 

+ T47, "DATE", T57, "TIME", T65, "FR #",T72,"REC #",T30,"#", 
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586 

537 

589 

589 

590 

591 

592 

593 

594 

595 

596 

597 

598 


r TN4X 
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+ T35, "VAC" , T90, "0K",T95, "TYPE" ; T 1 01 , "ID",T1 07, "DIST", 

+ T1 1 6, " AZ P03" ,T126,."EL P0S",2/) 

9110 FORMAT* /, "FMGR ERROR # »,I4> 

9120 FORMAT* /, "FMGR ERROR # M4," ATTEMPTING TO OPEN OR CREATE ", 
+ "MTDFIL" ) 

9130 FORMATS 7, "FMGR ERROR # ",14," IN WRITING TO DLU ",I2> 

9140 FORMAT< 1X,60A2) 

9150 FORMAT < /, "NOT ENOUGH ROOM ON DISK FOR ALL DATA FROM TAPE!") 
9160 FORMATS, "FMGR ERROR # ",14," ON DISK FILE" ) 

9170 FORMAT*/, IX, "NUMBER OF RECORDS: ",I5,/, 

+ IX, "TOTAL NUMBER OF WORDS: ",110,/, 

+ IX, "TOTAL NUMBER OF BINARY WORDS: ",I10> 

END 


COMPILER: HP92834 REV. 2130 <810716) 


NO WARNINGS ** NO ERRORS ** PROGRAM: 705 COMMON: * NONE ) 
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599 

C 




600 

C 

***H:Ht******:1t-******=ft*>tt >{<************ ************* 

601 

C 

:{t * * * * .'♦( + :* * * + :■(< * + + * * * * + ift * * * + + :* :* :* + * * + :* * :+c * :<t + :* * * rfe H< * + :+ :ft * * * 

6 02 

c 




6 03 


BLOCK 

DATA DIGB 


6 04 

c 




6 05 

c 




606 

c 




6 07 


COMMON 7DIGB7 ISCOD< 3, 1 2 >, INC0D<3,12>, ISDES<20, 12), 


6 08 


+ 

INDES< 20, 12 >, 0NT<12,2>, 


6 09 


+ 

IDIG( 2 ), ICCB<144>, ICNAM<3>, JSIZ<2>, 


610 


+ 

IDAY< 12,2), JDAY 


611 

c 




612 

c 




613 

c 




614 


DATA 

I CHAM 7 'CYCTIM ' 7 


615 


DATA 

JSIZ 71 00, 07 


616 


DATA 

ISCOD 7 ' SDB 1 SDB2 SDB3 SDB4 SDB5 

/ 

617 


+ 

'SDB6 SDB9 SDB10 SDB? SDB3 ' 7 


613 


DATA 

INCOD 7 'NDB 1 NDB2 NDB3 NDB4 NDB5 

t 

* 

619 


+ 

'NDB6 NDB9 NDB1 0 NDB7 NDB8 ' 7 


620 


DATA 

ISDES 7240+2H 7 


621 


DATA 

IHDES 7240+2H 7 


622 


DATA 

ISDES 7 'INSTRUMENT POWER 

r 

j 

623 


+ 

'PULSE LOAD BUS A 

/ 

f 

624 


+ 

'PULSE LOAD BUS B 

* 

t 

625 


+ 

'HEAD STANDBY HEATER POWER 

* 

* 

626 


+ ■ 

'DIGITAL B SPARE 

r 

t 

627 


+ 

'NOT USED 

4 

* 

628 


+ 

'NOT USED 

4 

J 

629 


+ 

'BLACKBODY HEATER POWER 

f 

t 

63 0 


+ 

'AZIMUTH MOTOR POWER 

4 

> 

631 


■ + 

'SCAN MOTOR POWER 

4 

* 

632 


+ 

'PED STANDBY HEATER POWER 

4 

> 

633 


+ 

'DIGITAL B SPARE 

' 7 

634 


DATA 

INDES 7 'INSTRUMENT POWER 

/ 

t 

635 


+ 

'PULSE LOAD BUS A 

4 

} 

636 


+ 

'PULSE LOAD BUS B 

> 

637 


+ 

'HEAD STANDBY HEATER POWER 

4 

t 

633 


+ . 

'INSTRUMENT HEATER BUS POWER 

* 

J 

639 


+ 

'NOT USED 

J 

640 


+ 

'NOT USED 

/ 

/ 

641 


+ 

'BLACKBODY HEATER BUS POWER 

/ 

t 

642 


+ 

'AZIMUTH MOTOR POWER 

t 

J 

643 


+ 

'ELEVATION MOTOR POWER 

4 

f 

644 


- + 

'PED STANDBY HEATER POWER 

4 

J 

645 


+ 

'DIGITAL B SPARE 

' 7 

646 


END 




-TN4X COMPILER: HP92834 REV.2t30 <310716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: < NONE ) COMMON: < NONE ) 

3LOCK COMMON DIGB SIZE: 7 76 


A- 21 


PAGE 17 


FTN , 


OPTS: 


LVI 


4’: 19 PM WED . , 23 JAN 


1985 


647 

643 

649 

650 

651 

652 

653 

654 

655 


C 

C 

C 

C 

c 

c 

c 


+ + + + + :fr ** + :+: + + + + + + + + + + .+ :-(t + + + + + + ;+: *:<< ++ + + + + + 4c :+:. + #:■(( + + + 4c + + + 

4< 4c ♦ * * * 4< 4« 4« 4« .♦ * * 4< + + -I* ■+• + 4c * * 4c 4< 4< + + 4c 4c 4c * * 4c 4c 4< 4c 4c 4< * + + 4c 4« 4c ■+ 4c * 4 c + 4c 4c 4c 4< 4< 4< * 4« 

BLOCK DATA BUF 


COMMON 7BUF7 IDCB<144), IBUF<3933>, 


656 

+ 

ICAR, NAM< 3 ) , ISIZC2), LUL, 

657 

+ 

ID, INST, MTFL , IVDF, ITEST< i 

653 

+ 

NOSER-: 2, 2), NO YR< 2 ) , NODAY< 2 

659 

+ 

NOMIN< 2 ), NOSEC< 2 ) , M0SEC<2) 

66 0 

+ 

ISTAF< 2 ), MTLU, LUNUM< 2 > 

661 

C 


662 

c 


663 

c 


664 

DATA 

IFIR, ILAS 71 ,32000/ 

665 

DATA 

ITEST 712*2H / 

666 

DATA 

ICOND 76*2H / 

667 

DATA 

NOSER 74*2H / 

663 

DATA 

NOYR 72+0/ 

669 

DATA 

NODAY 72*07 

670 

DATA 

IREEL 72*0 7 

671 

DATA 

NOHR 72*07 

672 

DATA 

NOMIN 72*07 

673 

DATA 

NOSEC 72*07 

674 

DATA 

MOSEC 72*07 

675 

DATA 

ISTAF 7-1, -17 

676 

DATA 

IREC 707 

677 

DATA 

ISIZ 7-1,07 

673 

DATA 

NAM 7 'MTDFIL ' 7 

679 

DATA 

ICAR 7207 

680 

DATA 

IFCAR, LCAR 720,237 

631 

DATA 

NCAR 717 

632 

DATA 

LUL 767 

633 

DATA 

MTLU 737 

634 

DATA 

LUNUM 76,87 

685 

END 


r TN4X COMPILER: 

HP92834 REV. 2130 <810716) 

** 

NO WARNINGS ** NO ERRORS ** PROGRAM: < NONE > 


IERR, LEN, 
IFIR, 


IREC, 
ILAS , 


HR, 

JTYPE, 


2 ) , ICOND< 3,2), 
IREEL< 2 ), NOHR< 2 ) , 
NCAR, IFCAR , LCAR , 


COMMON: <NONE> 


BLOCK COMMON BUF 


SIZE; 4145 
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686 

687 

633 

6S9 

690 

691 

692 

693 

694 

695 

696 

697 

698 

699 

700 

701 
7 02 
7 03 

704 

705 
7 06 
7 07 
7 08 
7 09 
71 0 
71 1 

712 

713 

714 

715 

716 

717 

718 

719 

720 

721 

722 

723 

724 

725 

726 

727 

728 

729 

730 

731 

732 

733 

734 

735 

736 

737 

738 

739 

740 


C 

C 

C 

C 

C 

C 

C 


C 

C 

C 


C 

c 

c 

c 

c 

c 

c 


c 

c 

c 


********************************************************* 
****************************************************** * * * 

SUBROUTINE READS 


COMMON 7BUF7 IDCB<144), IBUF<3938>, IERR, LEN, IREC, HR, 

+ ICAR, NAM< 3 >, ISIZ< 2 >, LUL, IFIR, ILAS, JTYPE, 

+ ID, INST, MTFL, IVDF, ITEST<6,2>, IC0ND<3,2>, 

+ NOSER-; 2, 2), NOYR< 2 ) , N0DAY<2>, IREELC2), N0HR<2>, 

+ NOMIN< 2 ) , NOSEC< 2 >, M0SEC<2>, NCAR , IFCAR , LCAR, 

+ ISTAF< 2 >, MTLU , LUNUM(2> 


LUT = LOGLU< IDUM ) 

CALL READF-; IDCB, IERR, IBFJF, 3938, LEN ) 

IF < I ERR .LT. 0) GOTO 5000 
JTYPE = I BUF 
IREC = IREC + 1 

***** IF THIS IS NOT A RECORD OF INSTRUMENT DATA, RETURN. 
IF < JTYPE .NE. 1) GOTO 5000 


***** CHECK THE DATA VALID FLAG. 
***** IF DATA VALID FLAG IS NOT 1 


RETURN 


, NE 


1642)) .OR. 
3938 THEN 


IVDF = IBUF< IND< 2 , 7 > ) 

IF < IVDF .NE , 1 > GOTO 5000 
INST = IBUF< 2 ) 

IF < < < INST .EQ. 0) .AND. < LEN 
+ < < INST .EQ. 1) .AND. < LEN .HE 

GOTO 5000 
ENDIF 

IDSTA = IBUF< IND< 3, 4 > > 

IF << IDSTA .EQ. 2HA > .OR. C IDSTA . EQ . 0>> THEN 
ID = 0 

ELSE 

ID = 1 
END IF 

HR = TIME< IBUF< 3 ) > 

II = ID + 1 

IF < ISTAF< II) .GT. -1) GOTO 5000 
I3TAF< II) a INST 
I TEST < 1 , 1 1 ) = I BUF< IND< 5,2)) 


DO 50 LLL =1,5 

ITEST<LLL+1,II> = JBUF< IHD< LLL, 3 ) ) 
50 CONTINUE 
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741 

742 

743 

744 

745 

746 

747 

748 

749 

750 

751 

752 

753 

754 

755 

756 

757 

758 

759 

760 

761 

762 

763 

764 

765 

766 

767 

768 

769 
77 0 

771 

772 

773 

774 

775 

776 

777 
773 
77 9 
730 

‘ 781 

782 

783 

784 

735 

736 

737 
733 

789 

790 

791 

792 

793 

794 

795 


C 

C . 

DO 75 LLL = 1 , 3 

I CQND< LLL ,11) = IBUF< INB<LLL,5)) 

75 CONTINUE 
C 
C 
C 

NOSER< 1,11) = IBUF< IND< 1,6)) 

N0SER<2,II) = IBUF< IND< 2,6)) 

NOYR< I I > a IBUF< IND< 1 ,2>) 

NQDAY< II) = IBUF< IND< 5,1)) 

NOHR< II) = IBUFC IND<4, 1 >) 

NOMIN< II) = IBUF< IND< 3,1)) 

NOSEC< II) = IBUF< IND< 2,1)) 

MOSECCII) = IBUF< IND< 1,1)) 

IREEL< II) = IBUF< IND< 4,5)) 

C 

C 

C 

URITE<LUT,91 00) IDSTA 

100 WRITE<LUT,9120) < ITEST< J, II ), J = 1 , 6 ) , < I COND< J # 1 1 >, J = 
+< NOSER< J, 1 1 ), J = 1,2), IREEL< II) 

READCLUT,*) ICODE 
IF < ICODE .EQ. 0) GOTO 5000 
GOTO <10,20,30,40) ICODE 
10 UR I TE< LUT ,9140) 

READ< LUT ,9130) < ITEST< J, 1 1 ), J = 1,6) 

GOTO 100 

20 URITE< LUT, 9160) 

READ< LUT, 9200) < ICOND< J, 1 1 ), J = 1,3) 

GOTO 100 

30 URITE< LUT, 9220 ) 

READ< LUT , 924 0 ) < NOSER< J, 1 1 ), J = 1,2) 

. GOTO 100 

40 URITE< LUT, 926 0 ) 

READ< LUT, * ) IREEL< II) 

GOTO 100 
5000 RETURN 
C 


C 

c 


***** FORMAT STATEMENTS 


9100 FORMAT< 
9120 FORMAT< 
+ 

+ 

+ 


7, "Station 
27 , 


9140 

9160 

9180 

9200 

9220 

9240 


FQRMAT< 

FORMAT< 

FORMATC 

FORMAT< 

FORMAT< 

FORMATC 


,1A2," Header 
Code Description 

1 Test Procedure 

2 Test Conductor 

3 Instrument S.N. 

4 Mag Tape Reel # 
Enter the code to modify 

7 , "Enter Test Procedure Name 


Information: " ) 

Value", 27, 
Name " ,6A2,7, 

" , 3A2, 7, 

" , 2A2, 7, 
",13,27, 

<0 for no change): 
<12 chars max): " 


7, "Enter 
6A2 ) 

3A2) 

7, "Enter 
2A2 ) 


Test Conductor <6 chars max) 


Instrument Serial Number <4 chars max) 


t 985 


1,3), 


> 

) 


" ) 
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796 9260 FORMAT< /, "Enter Mag Tape Reel Number: > 

79 7 END 

FTN4X COMPILER: HP92834 REV. 21 30 <81 071 6 > 

* + HO WARNINGS ** NO ERRORS ** PROGRAM: 769 COMMON: <NONE!> 
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798 C 

799 C 

800 C 
301 C 
3 02 ' 
803 
304 

3 05 
806 
307 


♦ * He * * .it + * * * * * * .* * * * * + :+! * + + * * * * H* * * * .+ * + + + * * * # * * •+ * •+. ♦ * * * * * * + * H»* + 

* :+: *.**:+: * :f -. *.■+•.** :+•. H< .-*:*.-* ****** * * * * ****************************** 

FUNCTION TIME< IB ) 

DIMENSION I B < 4 ) 

TIME = FLOAT< IB< 4 ) ) + FLOAT< IB<3> >/6G . + FLOATC IB< 2 > V3600 . 
+ + FLOAT< I8< 1 )>/360000. 

RETURN 

END 


FTN4N COMPILER: HP92S34 REV. 2130 <810716) 


+* NO WARNINGS ** NO ERRORS ** PROGRAM: 


62 


COMMON: <NONE> 


-■'AGE 22 FTH , 


OPTS: LYI 
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S.08- C 
8 09 C 
81 0 C 
81 1 C 
812 

813 C 

814 C 

815 C 

816 
317 
813 

819 

820 
821 

322 C 

323 C 
824 C 
325 
826 
827 C 

328 C 

329 C 
83 0 

331 

332 

333 C 
834 C 

335 C 

336 

337 
333 

339 

340 

341 

842 

843 
344 

845 

846 
347 

1 348 

349 

350 

851 

852 

853 C 

854 C 

355 C 

356 

857 

858 
359 
860 
861 
362 


■f - •*< * + :*.+ **:*:*:* * # :ft $ :<t :-|c # :* # :# * + H« :fc :* :fc :•(< .+ :■(< .+ + + + * + .+ + .+ 

* ;Jc * sfc Ht :# Ht :<t * * :-fc + * •+ & + * + .+ + + * * % + + * + * + * + •+ + * + * + -b + .+ + * + :<t + :f + -+ 

SUBROUTINE HEADR< KBUF, IK ) 


COMMON /BUF/ IDCBC144), .1 BUF< 3938 > I ERR , LEN, IREC, HR, 

+ ICAR, NAM< 3 ), IS IZ< 2 >, LUL, IFIR, ILAS, JTYPE , 

+ ID, INST, MTFL , IVDF, ITEST<6,2>, IC0ND<3,2>, 

+ NOSER< 2,25, NOYR< 2 ) , N0DAY<2>, I REEL< 2 ) , N0HR<2>, 

+ NOMIN< 2 ) , NOSEC’C 2 ), M0SEC<2>, NCAR, IFCAR , LCAR, 

+ ISTAF< 2 ), MTLU, LUNUM< 2 > 

***** PROCESSING OF DIGITAL A DATA < MAJOR FRAME HEADER INFO) 

DIMENSION KBUF< 128), KTINE< 6 ) , ITBUF<13) 

DIMENSION IDIST< 2 ), IAZ<2>, IELc‘2) 


EQUIVALENCE < IDIST< 1 ), DIST ) 
EQUIVALENCE <IEL<1),EL> 
EQUIVALENCE <IAZ<1),A2) 


LUT “ LOGLUCIDUM) 

MAFR = IBUF< IND< 2, 2 ) ) 

KTIME< 6 ) = IBUF< IND< 1,2)) 

DO 50 K = 1,5 

KTINECK) = IBUF< IND< K, 1 ) ) 

50 CONTINUE 

HR = TIME< IBUF< 3 ) ) 

MI.FR = IBUF< I ND< 1,4)) 

I DINS = I BUF< 2 ) 

IDSTA = IBUF< IND< 3,4)) 

IF << IDSTA .EQ. 2HA ) .OR, < IDSTA , EQ . 0)) THEN 
ID = 0 
ITSTA = 2HA 

ELSE 

ID = 1 
ITSTA = 2HB 
END IF 


IF < IDINS .EQ. 0) THEN 
I TINS = 2HNS 

ELSE 

I TINS = 2HSC 
ENDIF 
IDSTA = ID 
IDD = ID + 1 


A- 2 7 
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63 MAFT = IBUF< IND<4,4)) 

:64 MAGF = IBUF< INDC 5 , 4 ) ) 

(65 NTAB = IBUF< IND< 5, 5 > > 

(66 IVA. = IBUF< IND< 3,6)) 

(67 IF < IVA .EQ. 0) THEN 

(68 IVANS = 2HN 

*69 ELSE 

*70 IVANS = 2HY 

*71 ENDIF 

*72 LNPF = IBUF< IND< 1,7)) 

*73 NVALF = IBUF< IND< 2,7)) 

374 IF < NVALF . EQ . 0) THEN 

375 I NANS = 2HN 

376 ELSE 

377 INANS = 2HY 

378 ENDIF 

379 C IREEL< IDD ) - IBUF< IND< 4, 5 )> 

380 C 

381 C 

332 C 

333 C NGSER< 1 , IDD ) = IBUF< IND< 1 , 6 > > 

334 C N0SER<2,IDD) - IBUF< IHD< 2, 6 ) ) 

335 C 

336 C 

337 C • 

533 C ITESTC 1 , IDD ) = IBUFC IND< 5, 2 ) ) 

389 C DO 75 LLL = 1,5 

390 C ITESKLLL + 1 , IDD ) = IBUF< IND< LLL, 3 ) ) 

391 C 75 CONTINUE 

392 C 

893 C 

894 C 

395 IDIST<1) = IBUF< IND< 3,2)) 

896 IDIST< 2 ) = IBUF< IND< 4, 2 ) ) 

897 IA2< 1 ) = IBUF< IND< 4,6)) 

393 I A2< 2 > = IBUF< IND< 5,6)) 

399 IEL< 1 ) = IBUFC IND< 4,7)) 

900 I EL< 2 ) = IBUF< IND< 5,7)) 

901 CALL CNVTMC KTIME, ITBUF ) 

902 IJRITEC LUL, 1 ) < ITESTC J, IDD ), J = 1 , 6 ) , < ICONDC J , IDD ) , J = 1,3), 

■903 +< NGSER< J, IDD ), J = 1,2), ITBUF, 

904 +HR, MAFR, IREC, IREEL< IDD), IVANS, INANS, ITINS, ITSTA,DIST, A2, EL 

905 1 FORMATC 1 X, 6A2, 1 X, 3A2, 1 X, 2A2, 2X, 1 3A2, 1 X, F8 . 4, IX, 

906 +15, IX, 15, 4X, I3,4X,A2,3X,A2,3X,A2,4X,A2,3<E9.3, IX)) 

907 IF < IK .NE. 0) ENCGDE< 133, 1 , KBUF ) < ITESTC J, IDD ), J = 1,6), 

908 +< ICONDC J, IDD), J = 1 , 3 ), < NOSERC J, IDD >, J = 1,2), ITBUF, 

909 + HR, MAFR, IREC, IREEL< IDD), IVANS, INANS, ITINS, ITSTA,DIST, 

910 +A2 , EL 
91 1 C 

912 C 

913 C 

914 C 

915 RETURN 

916 END 
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FTH4X COMPILER: HP92834 REV. 2130 <810716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 502 COMMON: 


i 9S5 


< NONE ) 
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C 

C *********. ********************** ****.+•.*:**** + ******* ******** 

C ********************************************************* 

c 

FUNCTION IND<I,J> 
c 
c 
c 

. COMMON VBUF/ IDCB<144), IBUF<3933), I ERR, LEN, IREC, HR, 

+ ICAR, NAM< 3 > , I S I Z< 2 ) , LUL, IFIR, ILAS, JTYPE, 

+ ID, INST, MTFL, IVDF, ITEST<6,2>, IC0ND<3,2>, 

+ NOSER< 2,2?, NQYR< 2 >, N0DAY<2>, IREELC 2 ), N0HR<2>, 

+ NOMIN< 2 ) , NOSEC< 2 ), M0SEC<2), NCAR , IFCAR, LCAR, 

+ ISTAF< 2 ), MTLU, LUHUM< 2 > 

C 
C 
C 

I NT = 12 

IF <IBUF<2> . EQ . CO INT = 5 
I HD = < J-t >*INT +1+2 
RETURN 
END 


FTN4X COMPILER: HP92834 REV. 21 30 <81 071 6 > 

** HO WARNINGS +* NO ERRORS ** PROGRAM: 26 COMMON: (NONE) 


A- 30 


939 C 

940 C 

941 C 

942 C 

943 

944 

945 

946 

947 


:*:** :**;** ***+* + *** **:*#* + +•:* :f: :**#* + :* * + :4< >({ + .t + + 

He + :f( .+ Jfc :|t * -it -it * :* * * * :* * * * + * + * + + * ♦ + * + * * + + * * H* + * N< :<c * Jfc * ♦ :-(t :fr .+ + ^ :f * * :f< * 


SUBROUTINE ENC<N,KB,K, J,M, I FORM, L > 
DIMENSION K< 48 0 >,KB< 430 >> IFQRH< L ') 
ENCGDE< N, IFORM, KB >< K< I >, I=J,M> 
RETURN 
END 


FTH4X COMPILER: HP92834 REV.2130 <810716) 


+ + NO WARNINGS *« NO ERRORS ** PROGRAM: 


63 


COMMON: < NONE ) 


SUMRY 


SUMRY is a small but useful utility which provides a rapid 
means of listing the major frame headers contained on a test data 
tape. It lists the time of each major frame as well as the 
command echo and instrument status. SUMRY will work with either 
TRW tapes in "ERBE" format (for the TIROS instruments) or with 
tapes in the "PCM" format (for ERBS instruments). 

To use this program, mount the desired tape and type SUMRY 
on the consol. Answer the prompts as required. 
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*FILES<1,0) 

PROGRAM 5UMRY 
C 
C 
C 

C 3UMRY IS A PROGRAM USED TO SUMMARIZE ERBE DATA TAPES. 

C IT READS "TRW FORMAT” TAPES < EITHER ’TIP.OS "ERBE" FORM OR ERBS 

C "PCM" FORM) AND GENERATES LISTINGS OF MAJOR FRAME HEADER DATA. 

C 

C 

C 

COMMON /BUF/ INST, IANA 

DIMENSION LINE< 65), IDESC< 30 >, I TAPE< 1 0) 

LUT=LGGLU< IDUM) ! GET LU OF TERMINAL BEING USED 

100 WRITER LUT, 1 0 ) 

10 F0RMAT< " ENTER TAPE NUMBER < TRW# E.G.: E1147N)" ) 

READ<LUT, 1 1 )ITAPE ! GET TAPE NUMBER FOR PRINTOUT 

11 FORMATC10A2) 

WRITE< LUT, 12) 

12 F0RMAT< " ENTER TEST DESCRIPTION >C UP TO 60 CHARACTERS)") 

READ< LUT, 1 3 )IDESC ! GET TEST DESCRIPTION FOR PRINTOUT 

13 FORMATC 30A2 ) 

UR I TEC 6, 14)ITAPE, IDESC ! URITE0UT TAPE# AND TEST DESCRIPTION 

14 FORMATC 1H1 , IX, 1 0A2,/, 1X,3GA2, ) 

UIRITE< 6,15) 

15 FORMAT< /// ) 

OPEN< 3 ) ! OPEN THE TAPE FILE 

IREC=0 

1 READ< 8, ERR=98, END=99 )ITYPE, INST 

C READ A RECORD TO DETERMINE ITS RECORD TYPE AND THE INSTRUMENT TYPE 

IREC= IREC+ 1 

IF< ITYPE.EQ. 1 )CALL HEADR ! IF "ERBE" RECORD, CALL HEADR 

IF< ITYPE.EQ. 1 1 )CALL PCM ! IF "PCM" RECORD, CALL PCM 

IF< ITYPE . LT . 5 )G0T01 ! OTHERWISE CHECK THE NEXT RECORD 

IF< ITYPE.EQ. 1 1 )G0T01 ! IF IT WAS PCM GO BACK TO TOP FOR ANOTHER 

BACKSPACE 3 

READC 3,4, I0STAT=I0S,ERR=93,END=99XLINE< I ), 1 = 1 ,65) 

4 FGRMAT< 2X, 65A2 ) 

URITE< 6, 9 )LINE 
9 F0RMAT< 1X,65A2) 

GOTOI 

93 WRITE<6,7)I0S, ITYPE 

7 FQRMAT< " I0S=",I5," ITYPE= ".,04) 

99 CONTINUE 

URITE<LUT, 1 099) 

1099 FORMATS "EOF ENCOUNTERED, ENTER OPTION:",/, 

1" 0= STOP",/," 1= CONTINUE BUT WITH NEW DESCRIPTION",/, 

1" 2= CONTINUE") 

READ< LUT, * )IOPT 

IF< IOPT.EQ. 1 )G0T01 00 

IF( IOPT . EQ . 2 )GOTO 1 

STOP 

END 
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55 

56 C 

57 C 
53 C 

59 C 

60 C 

61 C 


SUBROUTINE HEADR 


THIS SUBROUTINE PROCESSES HEADR INFORMATION FOR '’ERBE" < TIROS) 
RECORDS, 


62 C 

63 COMMON/BUF/INST, IAHA 

64 DIMENSION KTIME< 6 >, ITBUF< 1 3 > , ID IST< 2 ) , I AZ< 2 ) , IEL< 2 ) 

65 DIMENSION C14< 6 ), Cl 5< 6 ) 

66 DIMENSION IBUF< 3936 >, LBUF< 3933 ) 

67 EQUIVALENCE< IDIST< 1 ), DIST ) 

63 EQUIVALENCE*: IAZ< 1 >,AZ> 

69 EQUIVALENCE< IEL< 1 ), EL ) 

70 DATA NREC/07 

71 DATA C14/347. 83511 ,-583. 00496, 489 , 0738,-21 1 .33864, 

72 145. 022096,-3.79443787 

73 DATA C15/90. 962177, -172. 73195, 163,50204,-90.571380, 

74 123.545091 ,-2.333221897 

75 DATA MASK/777B7 

76 DATA MAS2/777787 

77 BACKSPACE 8 

73 NREC-NREC+1 

79 LUT =LGGLU< IDUM ) 

80 -LIM-1642 

SI IF< INST.EQ. 1 )LIM=3938 

82 LIM2=LIM-2 

83 CALL LGBUF<. LBUF , L IM ) 

84 READ<3, I03TAT=I03 , ERR=98 , END=99 >ITYPE , INST,< IBUF< I ), 1=1 ,LIM2> 

85 MF=9? 

86 IFC INST.EQ. 0)MF=4t 

87 NFRAM=I AND< IBUF< MF ), MASK ) 

89 IF< INST.EQ. 0 )G0T048 

39 IDEL=39-NFRAM 

90 IF< IDEL.LT. 0 )IDEL=IDEL+320 

91 IPT=MF+IDEL*12+1 1 

92 I ECH= IBUF< I PT ) 

93 ISTAT=IBUF< IPT-1 ) 

94 . G0T049 

' 95 48 IDEL=320-NFRAM 

96 IF< IDEL . GT . 31 9 )IDEL=0 

97 IPT=MF+IDEL*5+4 

98 IECH=IBUF< IPT) 

99 ISTAT=IBUF< IPT+5) 


100 

49 

CONTINUE 

101 


KTIME< 6 )=IBUF< IND<2, 1 )) 

1 02 


DO 50 K= 1 , 5 

1 03 


KTIME< K )=IBUF< IND< 1 ,K)) 

1 04 

50 

CONTINUE 

1 05 


CALL CNVTM<KTIME, ITBUF) 

1 06 


IVA=IBUF< IND< 6 , 3 > ) 

1 07 


IF< IVA.EQ. 0 )THEN 

1 03 


VAC= 4HAIR 

1 09 


ELSE 
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1 I 0 
.1 1 1 
1 12 
1 13 
1 14 
1 15 
1 16 
1 1? 

118 
1 19 
120 
121 
122 

123 

124 

125 

126 
12? 

128 

129 

130 

131 101 
1 32 
133 

1 34 

135 98 

136 

137 1 00 

138 99 

139 


VAC =4HVAC 
ENDIF 

NVAL=IBUF< IND< 7,2)) 

IF< NVAL , EQ , 0 )THEN 

I VAL=2HN 

ELSE 

IVAL=2HY 

ENDIF 

IDIST< 1 )=IBUF< IND<2,3)> 

IDIST< 2 >=IBUF< IND< 2, 4 ) > 

IAZ< 1 )=IBUF< IND< 6,4)) 

IA2< 2 )=IBUF< IND< 6,5)) 

IEL< 1 )=IBUF< IND< 7,4)) 

IEL< 2 )=IBUF< IND<7,5)) 

INS=2HNS 

INSTR=IBUF< IND< 4,2)) 

IF< INST.EQ. 1 >INS=*2HSC 
IST=IBUF< IND<4,3 )) 

MA JF=IBUF( IND< 2,2)) 

WRITE< 6, 1 01 )NREC, ITBUF, INS, 1ST, NVAL, IVA 
1 , INSTR 

FORMAT< 15, 2X, 13A2,2X,A2,2H,A2,2X, 12, 13, 
1 " COMMAND ECHO M6.2X," STAT ",I6,2X," 
1 " MAJ F#: ”,I5,A2) 

RETURN 

CONTINUE 

WRITE< LUT, 1 00)IOS 

FORMAT*.' " ERROR ON TAPE=",I5) 

RETURN 

END 


FTN4X COMPILER; HP92834 REV. 2130 <810716) 


++ HO WARNINGS ** NO ERRORS +* PROGRAM: 8353 


I 


, IECH, ISTAT, NFRAM, MA JF 
1ST mf : ", 15, 


COMMON: (NONE) 
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140 

141 C 

142 

143 C 

144 C 

145 C 

146 C 
14? 

143 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 100 

159 9 0 

160 

161 98 

162 101 

163 

164 99 

165 102 
1 66 

167 


SUBROUTINE PCM 


THIS SUBROUTINE PROCESSES HEADR INFORMATION FOR "PCM* 1 RECORDS 


DIMENSION IBUF< 1700), JBUFC ?>,LBUF< 1700) 

EQUI VALENCE< IBUF< 1 ), JBUF< 1 ) ) 

BACKSPACE 8 
LUT=LOGLU< IDUM ) 

CALL LGBUF<LBUF, 1700) 

READ<8, IOSTAT=IOS, ERR =98, END=99)IBUF 
DO 30 L= 1,4 
K=< L~ 1 )*4 0 0 

WRITE<6, 1 00) IBUF< 143+K), IBUF<293+K), IBUF<297+K), I BUFC 3 06+K ) , 
*IBUF< 31 0+K ), IBUF< 455+K ), IBUF< 468 + K), J6UF<5), JBUF<4>, JBUF<3>, 

* JBUF< 6 ) , JBUF< 7 ) 

F0RMAT<7I1 0, 5X,5I6 ) 

CONTINUE 

RETURN 

WRITE< LUT, 101 )IOS 
FORMAT< " ERROR # ",I5) 

RETURN 

WRITER LUT, 1 02 ) 

FORMATC" EOF”) 

STOP 

END 


FTN4M COMPILER: HP92834 REV. 21 30 <810716) 


** NO WARNINGS ** NO ERRORS ** 


PROGRAM: 3575 


COMMON: <NONE> 


HAGE 

6 

FTN . 

OPTS: LYI 

168 


BLOCK 

DATA BUF 

169 


COMMON/BUF/INST, IANA 

170 


DATA 

INST/0/ 

171 


DATA 

IANA/0/ 

172 


END 
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FTN4X COMPILER: HP92834 REV. 21 30 <810716) 

** NO WARNINGS +* NO ERRORS ** PROGRAM: < NONE ) COMMON: 

BLOCK COMMON BUF SIZE: 2 


1 985 


< NONE ) 


PAGE 

7 
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173 


FUNCTION IND< I , J ) 

174 


COMMON /'BUF/IHST 

175 


INT=5 

176 


IF< INST.EQ. 1 )INT=1 2 

177 


IND=< 1-1 )*INT+J 

178 


RETURN 

179 


END 


4 : 43 PM WED . , . 23 JAM . , 


FTN4X COMPILER: HP92834 REV. 2130 <810716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 25 COMMON: 


1985 


< NONE ) 
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TIP 


TIP is a program used to convert TIP tapes (TIROS 
Information Processor) to TRW "ERBE" format tapes. Major frames 
of data are extracted from the TIP data stream for both the 
scanner and non-scanner instruments. The data is not merged, but 
output as separate major frames of non-scanner and scanner data 
with the convention that the scanner will always be designated 
"station A" and the non-scanner "station B". The tapes created 
by this TIP program can be processed using programs developed 
under this contract (such as MAGAN, SUMRY etc.) or processed by 
TRW software on the HP-1000 computer. 

To run TIP, mount a TIP tape (generated at RCA during TIROS 
integration and testing) and then type TIP. Answer the computer 
generated questions appropriately. 
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2 $FILES< 1,1) 

3- PROGRAM TIP 

4 C PROGRAM TIP IS DESIGNED TO READ TIP <TIROS INFORMATION 

5 C PROCESSOR) DATA TAPES AND EXTRACT ERBE INSTRUMENT DATA. 

6 C IT (JILL REFORMAT THE ERBE DATA IN A FORM COMPATABLE (JITH 

7 C THE TRU BCU SOFTWARE FOR DATA ANALYSIS. 


3 C 
9 C 
10 C 
1 1 C 

12 C 

13 C 

14 C 

15 C 

16 C 

17 C 

18 

19 

20 
21 
22 

23 

24 C 

25 C 

26 C 

27 
23 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 
43 

49 

50 

51 

52 C 

53 

54 

55 

56 


MAJOR FRAMES OF DATA ARE EXTRACTED FROM THE TIP DATA FOR BOTH 
THE SCANNER AND NON-SCANNER AT THE SAME TIME. THE DATA IS NOT 
MIXED, BUT OUTPUT AS SEPARATE MAJOR FRAMES WITH THE CONVENTION 
THAT THE SCANNER WILL ALWAYS BE DESIGNATED AS "STATION A" AND 
THE NON-SCANNER AS "STATION B" . 


DIMENSION IHD< 32 ), ICHAN< f60),NCHAN< 160), IPBUF<6) 

DIMENSION NAME< 3 ) , NAM< 5 ) , NAM2< 5 ) ! NAME=TEST CONDUCTOR ; NAM=OUTPUT FIL 

DIMENSION I BUF< 1 024),LBUF< 1 024), JBUFC53, 1 0 ), LLBUF< 3933 ) 

DIMENSION ISCAN<3933),NSCAN< 1642), I HEAD< 96 ) , NHEADC 4 0 ) 

DIMENSION IFRAM< 1 2, 320 ), NFRAMC 5, 320 ) 

EQUIVALENCE< IHEAD< 1 >, ISCAN< 3 ) ), < NHEAD< 1 ),NSCAN<3)) 


EQUIVALENCE< IFRAM< 1 ), ISCAN< 99 > ), < NFRAM< 1 ), NSCAN< 43 ) ) 

EQUIVALENCE< JBUF< 1,1), IBUF< 1 ) ) 

EQUIVALENCE <LBUF< 1 ),LLBUF< 1 )) 

DATA ISC,NSCX060000B, 060000B/ 

DATA IBOMB/17 
DATA ISTR/1 / 

DATA ISCF, NSCF/0, 0/ 

DATA LUIN ,LU0UT/8 , 7/ ! WHEN TAPE TO TAPE COPY, LUIN=9? AND LU0UT=3 

DATA I ANS71 / 

DATA MASK/777B/ ! MINOR FRAME# MASK 

DATA IDIGB,NDIGB/7777B, 7777B/ ! DIGB START VALUESC SCANNER, NON-SCAN 

DATA Ml , M2 , M3, M4, M5, M6/1 7776 OB , 17B, 1 774 0 0B, 377B, 1 70 00 OB, 7777B/ 

DATA IB15, IB14, IB13, IB 1 2/1 OOOOOB,40000B,2000QB, 1 0 00 OB/ 


DATA IND/t ,11, 11, 2, 3, 11, 11, 11, 4, 11, 5, 6, 11, 7, 11, 11, 11, 8,9, 10, 1 2* 11/ 
DATA ICHAN/4*1000B, 0,7*1 000B,400B, 1 4*1 000B, 1 400B, 7*1 000B, 2000B, 

17*1 000B,2400B,7*1 00 OB, 300 OB, 7*1 00 OB, 340 OB, 7*1 00 GB, 4000B, 31 *1 0 0 OB, 
1600 OB, 7*1 000B,6400B, 8*1 00 0B,700 0B,3*1 00 OB, 740 OB, 39*1 0 00BX 
DATA NAM/'MTDFIL: : 21 V 
DATA NAM2/'MT0FIL: ! 22 V 

DATA NCHAN75*1 OOOB, 0,7*1 0 008, 4 0 0B, 1 4*1 0 0 OB, 1 40 OB, 1 6* 1 0 0 0B , 240 OB, 

1 7*1 000B, 3000B, 6*1 000B, 3400B, 7*1 000B, 4000B, 31 *1 000B, 6000B, 7*1 000B, 

1 6400B, 8*1 Q00B,7000B, 6*tQ00B, 74 0 OB, 35*1 OQOB7 


LUT=LOGLU< IDUM) 

CALL LGBUFCLBUF, 1 024) 
ISCAN< 1 )=1 

NSCAN< 1 )=1 
ISCAN< 2 )=1 
NSCAN< 2 )=0 
IHEAD< 33 )=2HSC 


} GET LU OF OPERATOR'S TERMINAL 
•THE TIP RECORDS ARE 1024 WORDS LONG 
! INDICATES INSTRUMENT DATA TO 
! TRU ERBE SOFTWARE 
'SAME AS ABOVE LINE 

! INDICATES SCANNER 
! INDICATES NON-SCANNER 
! INDICATES SCANNER 
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57 

58 

59 
SO 
61 
62 

63 

64 

65 

66 

67 1000 

68 

69 1 001 

70 


71 1005 

72 

73 1007 

74 

75 

76 1002 


78 

79 1008 
30 

81 

82 1 003 

83 
34 
85 

36 

37 

38 

39 
90. 

91 1004 

92 

93 

94 1017 

95 

96 

97 


93 

1 016 

99 


1 00 


1 01 

1 019 

1 02 

1-021 

1 03 


1 04 

1 022 

J 05 


1 06 


1 07 


1 03 


1 09 


1 1 0 


1 1 1 



NHEAD< 1 7 )=2HNS 
IHEADC 39 )=2HA 
NHEADC 1 8 )=2HB 
IHEADC 1 4 )=0 
NHEAD<7)=0 
IHEADC 63 )=0 
IHEAD< 74 )=1 
NHEADC 23 )=0 
NHEAD< 32 )=1 


! INDICATES NON-SCANNER 
..‘SCANNER WILL ALWAYS BE STATION A 
.‘NON-SCANNER WILL ALWAYS BE STATION B 

i I nitialize major frame counter< scanners 

‘INITIALIZE MAJOR FRAME COUHTER< NON-SCANNER 
! VAC FLAG < SET TO ZERO) 

! VALID DATA FLAG <SET TO 1 FOR VALID) 

! VAC FLAG FOR NON-SCANNER 
! VALID DATA FLAG NON-SCANNER 


WRITE< LUT, 1 000) 

FORMAT< H ENTER TEST PROCEDURE- FOR SCANNER<12 CHARACTERS)") 
READ< LUT, 1 001 )IHEAD< 17), < IHEADC KK ), KK=25, 29 ) 

F0RMAT< 6A2 ) 

WRITE< LUT, 1 005) 

FORMATC " ENTER SERIAL NUMBER FOR SCANNER") 

READ< LUT, 1 007 )IHEAD< 61 ), IHEADC 62 ) 

FQRMATC 2A2 ) 


WRITEC LUT, 1 002) 

FORMATC " ENTER TEST PROCEDURE FOR NON-SCANNER< 12 CHAR)") 
READ< LUT, 1 001 X NHEAD< KK ), KK=1 0,15) 

WRITECLUT, 1 003) 

FORMAT< " ENTER SERIAL NUMBER FOR NON SCANNER") 

READCLUT, 1 00? )NHEAD< 26 ), NHEApC 27 ) 

WRITECLUT, 1 003) 

FORMATC " ENTER INITIALS OR NAMEC6 CHARACTERS)") 

READ< LUT, 1 001 X NAME< KK ), KK=1 ,3) 

IHEADC 49 >=NAME< 1 ) 

IHEAD< 50 )=NAME< 2 ) 

IHEAD< 51 )=NAME< 3 ) 

NHEADC21 )=NAMEC 1 ) 

NHEADC 22 )=NAME< 2 ) 

NHEAD< 23 )=NAME< 3 ) 

WRITEC LUT, 1 004 ) 

FORMAT< " ENTER YEAR <4 DIGITS)") 

READC LUT, * )NYR 
WRITECLUT, 1 017) 

FORMAT< " DO YOU WANT TO COPY SCANNER DATA? <Y/H>") 

READC LUT, 1 022)1 JK 
IF< I JK.EQ. 1HY)ISCF=1 
WRITEC LUT, 1 016) 

FORMAT< " DO YOU WANT TO COPY NON SCANNER DATA? <Y/N)" ) 
READ< LUT, 1022)1 JK 
IF< I JK.EQ. 1HY)NSCF=1 
WRITEC LUT, 1021) 

FORMATC" IS THIS A TAPE TO TAPE COPY <Y/N)") 

READ< LUT, 1 022)1 JK 
FORMATC A1 ) 

IF< I JK.EQ. 1HN)G0T01 023 
IF< I JK.NE. 1HY)G0T01 019 
LUIN=9 
OPENCLUIN) 

LU0UT=3 

OPENCLUOUT) 

WRITEC LUT, 1024) 
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1024 FORMAT< " MOUNT SOURCE TAPE ON DYLON TAPE UNIT ”,/, 

. 1" MOUNT DESTINATION TAPE ON HP TAPE DRIVE" ,/, 

1" TYPE GO WHEN READY »> 

READ< LUT, 1 022 >1 JK 
GOT0 1 

1023 CONTINUE 

GPEN< LUIN > 

OPEN< UNIT=LUQUT ,FILE=NAM, I0STAT=I0S,ERR=t999> 

WRITE<LUT, 1997) 

1997 FQRMAT< " ^H^J" > 

GOTOI 

1999 URITE< LUT, 1998>IQS,NAM 

1998 FORMATS" ERROR#" , 15, " TRYING TO OPEN ",582) 

STOP 

I NMF=0 

10 READ< LUIN,ERR=98, END=67, IQSTAT=IOS )IBUF 

G0T063 

67 WRITE<LUT,69> 

69 FORMATC" END OF INPUT TAPE, ENTER GO TO CONTINUE WITH ANOTHER”,/ 

1” INPUT TAPE AND SAME OUTPUT TAPE < ANYTHING ELSE ABORTS)") 

READ< LUT, 1 001 >IOP 
IF< IOP . NE . 2HG0 )G0T0887 
GOTOI 0 

68 CONTINUE 

MF=IAND< MASK, IBUFC 3 ) ) 

I F< MF . EQ . NMF )GOT 0 1 2 
URITE< LUT, 1 01 1 >NMF, MF 

1011 FORMAT< “ EXPECTING MINOR FRAME# " , I 5 , " BUT FOUND MF#",I5> 

WRITE< 6,1011 )NMF, MF 
IF< MF . EQ . 0 )G0T01 2 

NMF=0 ! NEED TO SEARCH FOR MF=Q 3.START OVER 

DO 11 N=2, 1 0 

MF=IAND< MASK, JBUF< 3, N ) ) 

IF< MF . NE . 0 )GOT0 1 1 
MFF=*1 

MFL=1 +1 0-N 
K=N- 1 
GOT0 13 

II CONTINUE 

GOTOI iDIDN'T FIND MF=0 IN THIS GROUP, TRY AGAIN. 

1 2 MFF=MF+ 1 
MFL=MF+ 1 0 
K= 0 

IF< MFL . GT . 320 )MFL=320 

13 DO 990 M=MFF,MFL 
K=K+1 

IFRAM< 1 ,M )=IOR( ISC,M-1 > > SCANNER MINOR- FRAME# 

IFRAM<5,M)=ISHFT< IAND< JBUF< 1 0,K),M1 >,-4) 

IFRAM< 6, M )=IQR< ISHFT< IAND< JBUF< 1 0, K ), M2 ), +8 >, 

1 1SHFT< IAND< JBUF< 15,K),M3>,-3)> 

IFRAM< 7, M )=IQR< ISHFT< IAND< JBUF< 1 5 , K >, M4 >, +4 ), 

1 ISHFTC IAND< JBUF< 23, K ), M5 ) , -1 2 ) > 

IFRAM< 8, M )=IAND< JBUF< 23, K ), M6 ) 

IFRAM< 9, M )=ISHFT< IAND< JBUF<31 ,K),M1 ),-4) 

IFRAM< 1 0,M)=IOR< ISHFT< IAND< JBUF< 31 , K ), M2 >, +3 >, 
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16? 

J 68 

169 

170 

171 

172 

173 C 

174 

175 C 

176 

177 
173 C 
173 C 

180 C 

181 C 

182 C 

183 C 

184 C 

185 C 

186 C 

187 C 
138 C 

189 C 

190 900 

191 

192 

193 

194 901 

195 

196 
19 ? 

198 

199 

200 

201 902 

202 
203 
2 04 
205 

j 206 
( 207 903 
208 
: 209 
210 
21 1 

212 904 
I 213 

214 

215 905 

216 

217 

218 906 

219 

220 

221 907 


1 ISHFTC IAND< JBUFC 37, K>, M3 >, -8 > > 

IFRAM< 1 1 ,M>=IOR< ISHFT< I AND< JBUF< 37, K >,M4 >,+4 >, 

1 ISHFTC IAND< JBUF< 44, K ), M5 >, -1 2 > > 

IFRAM< 1 2, M )=IAND< JBUF< 44, IO, M6 ) 

NFRAM< 1 ,M>=IOR<NSC,M-1 !> ! NON-SCANNER MINOR FRAME# 

NFRAM<5,M>=JBUF<2?,K> 

DIGB SECTION FOLLOWS 

JB= JBUF< 7 , K ) ITHE 7TH WORD OF EACH TIP MINOR FRAME FREQUENTLY 

CONTAINS ONE OR MORE "DIGITAL B" BIT VALUES 
GOTO< 900, 901 ,902,903,904,905,906,907,908,909,91 0> 

1 IND< MOD< M-l , 32 )+1 ) ITHIS COMPUTED GOTO WILL SELECT THE APPROPRIATE 

ACTION ACCORDING TO THE MINOR FRAME NUMBER. 

THE " IND" ARRAY IS INITIALIZED WITH A DATA STATEMEK 
AND USED TO DIRECT THE TRAFFIC AS THE MINOR FRAMES 
ARE PROCESSED. THE PATTERN REPEATS EVERY 32 MINOR 
FRAMES, AND THEREFORE THE MODULUS EXPRESSION 
IN PARENS WILL EVALUATE TO ONE OF THE 32 VALUES 
FOR WHICH THERE IS A ENTRY IN “IND". ONLY 1 1 
BRANCHES ARE NEEDED TO HANDLE ALL CASES BECAUSE 
THERE ARE A NUMBER OF MINOR FRAMES WHICH DO NOT 
HAVE DIGITAL B DATA. SO "IND" HAS 32 ENTRIES IN 
IT, BUT ONLY 11 DIFFERENT VALUES. 

IF<M.EQ. 1 JG0T091 0 • J ESI 0 SCAN MOTOR PUR < EXCEPT MINOR FRAME 0) 

NBIT=9 

IDIGB=IPOKE< IDIGB,NBIT, IAND< JB, IB12>> 

G0T091 0 

NBIT=1 ! ES2 PULSE LOAD BUS-A 

IDIGB =IPOKE< IDIGB,NBIT, IAND< JB, IB14>> 

NBIT=7 ! ES6 BLACKBODY HTR PWR 

IDIGB=IPOKE< IDIGB,NBIT, IAND< JB, IB13) ) 

NBIT=7 ! ENS6 BLACKBODY HTR PWR 

NDIGB=IPOKE<NDIGB,NBIT, IAND< JB, IB12>) 

G0T091 0 

NBIT=8 ! EHS9 AZIMUTH MTR PUR 

NDIGB=IPOKE< NDIGB, NBIT, IAND< JB, IB15)) 

NBIT=1 1 ! NS SPARE 

NDIGB=IPOKE< NDIGB, NBIT, IAND< JB, IB14>> 

GOT0910 

NBIT=4 ISCANNER SPARE 

IDIGB=IPOKE< IDIGB, NBIT, I AND< JB, IB13)) 

NBIT=1 0 !PED STANDBY HTR PWR < SCANNER ) 

IDIGB=IPOKE< IDIGB, NBIT, IAND< JB, IB12)> 

GOT0910 

NBIT=4 INS INST HTR PUR 

NDIGB=IPOKE< NDIGB, NBIT, IAND< JB, IB14)> 

GOT0910 

NBI T=9 INSELEV. MTR PWR 

NDIGB=IPOKE<NDIGB,NBIT, IAND< JB, IB15)) 

GOTO910 . 

NBIT=2 ISC PULSE LOAD BUS B 

IDIGB=IPOKE< IDIGB, NBIT, IAND( JB, IB14)) 

G0TO910 

NBIT=0 ISC INSTR POWER 
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222 

223 

2.24 

225 

226 
22 ? 

229 

229 

230 908 

231 

232 

233 

234 

235 

236 
23? 

233 

239 909 

240 

241 910 

242 

243 

244 C 
.245 C 
246 
24? 

243 

249 

250 

251 

252 990 

253 

254 

255 

256 

257 
259 

259 

260 
261 
262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

273 

274 

275 

276 


IDIGB=IPOKE< IDIGB, NBIT, I AND< JB, IB1 5 > > 

NBIT=3 ISC STANDBY HTR PWR 

IDIGB=IPOKE< IDIGB, NBIT, IAND< JB, IB14>> 

NBIT=3 ISC AZIMUTH MTR PWR 

IDIGB = IPOKE< IDIGB, NBIT, IAND< JB, IB13>> 

HBIT=1 1 ISC SPARE 

IDIGB=IPOKE< IDIGB, NBIT, I AND< JB, IB12>> 

G0TO910 

NBIT=0 INS INST PWR 

NDIGB = IPOKE< NDIGB, NBIT, IAND< JB, IB15>> 

NBIT=1 INS PULSE LOAD 

NDIGB=IPOKE< NDIGB, NBIT, IAND< JB, IB14>> 

NBIT=2 INS PULSE LOAD 

NDIGB=IPOKE< NDIGB, NBIT, IAND< JB, I B 1 3 > > 

NBIT=3 INS- HEAD STDBY 

NDIGB=IPOKE< NDIGB, NBIT, IAND< JB, IB 12 >> 

G0T091 0 

NB I T= 1 0 INS PED STDBY HTR PWR 

NDIGB = IPOKE< NDIGB, NBIT, IAND< JB, IB15)) 

IFRAM< 2, M )= IDIGB ! UPDATE THE SCANNER DIG B WORD 
NFRAM< 2 , M )=NDIGB 'UPDATE THE NON-SCANNER DIG B WORD 

LOW=IAND< JB,M4) 'GET LOW BYTE OF WORD? 

THIS WORD WILL SOMETIMES CONTAIN 
ANALOG HOUSEKEEPING TELEMETRY DATA 

JCHAN=MODCM, 160) 

IF< JCHAN . EQ . 0 ) JCHAN=1 

IFRAM< 3, M )=ICHAN< JCHAN )+LGU/4 + 200B 

NFRAM< 3 , M )=NCHAN< JCHAN )+L0W/4 + 200B 

IFRAM<4,M)=1000B »BCU CHAN2 C DUMMY ) 

NFRAM< 4, M )=*1 OO0B 

CONTINUE 

NMF=M-1 

IF( NMF . LT .320 )GOTO 1 0 
IHEAD< 1 4 )=IHEAD< 14)+1 
NHEAD< 7 )=NHEAD< 7 )+1 
NDAY=IBUF< 531 ) 

NHR=IBUF< 532 ) 

NMIN=IBUF< 533 ) 

NSEC=IBUF< 534 > 

NMSEC=0 

IHEAD< 1 )=NMSEC 

IHEAD< 2 )=NSEC 

IHEAD< 3 )=NMIN 

IHEAD< 4 )=NHR 

IHEADC 5 )=NDAY 

IHEAD< 1 3 )=NYR 

NHEAD< 1 )=NMSEC 

NHEAD< 2 )=NSEC 

NHEAD< 3 )=NMIN 

NHEAD< 4 )=NHR 

NHEAD< 5 )=NDAY 

NHEAD< 6 )=NYR 

CALL LGBUF< LLBUF, 3938 ) 

WRITE< LUT , 1 996 >NHR, NMIN, NSEC , NMSEC, NDAY, NYR, IFRAMC 1 1 ,40), 

*IFRAM< 12,40 ), NFRAM< 5, 2 ), NFRAM< 5, 1 ) 


BUS-A 

BUS-B 

HTR 
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277 WRITER 6, 1 996 >NHR, NM IN, NSEC, NMSEC, NDAY, NYR, IFRAM* 11,40), 

273 *IFRAM* 1 2 , 40 ), NFRAM* 5 , 2 ) , NFRAM* 5 , 1 > 

279 1996 FORMAT*" HR MIN SEC NMSEC DAY YEAR SCAN STAT ECHO”, 

230 *" NSCAN STAT ECHO" ,/, 415, 217, 4110) 

281 IF< IFBRK* IDUM))1991 ,1990,1991 

232 1991 WRITE*LUT, 1992) 

233 1992 FORMAT*" ENTER 1 TO START OR CONTINUE SAVING DATA" ,/, 

284 1" -1 TO STOP PROGRAM 

285 1" 0 TO STOP SAVING DATA BUT CONTINUE READING " > 

236 READ* LUT,* HANS 

237 1990 IF* IANS.EQ.-1 )GOTO 887 

283 IF* IANS.EQ. 0)GOTO 886 

239 2700 IF* ISCF.EQ. 1 )WRITE* UNIT=LUOUT, ERR=88, IOSTAT=IOS >ISCAN 

290 I B0MB=2 

291 2701 IF* NSCF . EQ . 1 MJRITE* UNIT=LUOUT, ERR=88, IOSTAT=IOS)NSCAN 

292 I BOMB= 1 

293 886 NMF=0 

294 IF* K . EQ . 1 0 )G0T01 

295 MFF= 1 

296 MFL=1 0-K 

297 GOT013 IFINISH WITH THE DATA IN THE BUFFER 

293 S3 ENDFILE* LUOUT ) 

299 CLOSE* LUOUT) 

300 OPEN* UNIT=LUOUT, FILE=NAM2,I0STAT=I0S,ERR=1999) 

301 IF* IBOMB.EQ. 1 )GOT02700 

302 GOT02701 

303 887 ENDFILE LUOUT 

304 ENDFILE LUOUT 

305 CLOSE * LUOUT) 

306 STOP 

307 98 WRITE*LUT, 988 >I0S 

308 988 FORMAT*" ERROR #",I5," ON TAPE FILE" ) 

309 99 STOP 

310 END 


FTN4X COMPILER: HP92834 REV. 2130 *310716) 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 13042 COMMON: * NONE ) 
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311 FUNCTION IPOKE< I WORD, NBIT, IBIT) 

312 C 

313 C THIS FUNCTION (JILL STASH A ZERO OR ONE ^ACCORDING TO THE VALUE 

314 C OF IBIT > IN THE WORD IUORD AT BIT POSITION NBIT . 

315 C NBIT CAN BE ANY NUMBER FROM 0 TO 15. IBIT CAN BE 0 <2ER0) OR 

316 C NON ZERO. A ZERO WILL CAUSE ONE BIT OF IUORD TO BE SET TO ZERO . 

317 C A NON ZERO VALUE WILL CAUSE ONE BIT OF IUORD TO BE SET TO ONE. 

318 DATA MM,NN, JJ/1 77777B, 077777B, 1 00000B7 

319 IF<NBIT.EQ. 15>THEN 

320 MAS=NN ! IF NBIT IS 15, SELECT MASK 'NN' 

321 ELSE 

322 MAS=MM-2**NBIT 1 OTHERWISE, CONSTRUCT A MASK 

323 ENDIF 

324 IPOKE=IAND< IUORD, MAS) ! GRAB ALL THE BITS EXCEPT THE ONE MASKED OFF 

325 IF< IBIT.EQ. 0 >RETURN ! IF IBIT IS ZERO, THE JOB IS DONE. 

326 IF< NBIT . EQ . 1 5 >THEN 

327 IPOKE=IOR< I POKE, JJ ) ! IF REPLACING 15TH BIT, USE MASK 'JJ' 

328 ELSE 

329 IPOKE=IOR< I POKE, 2**NBIT > ? OTHERWISE 'OR' IN THE BIT. 

330 ENDIF 


331 RETURN 

332 END 


FTN4X COMPILER? HP92334 REV. 2130 <810716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 50 COMMON: <NGNE) 
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PCM is a format conversion program. It is designed to read 
ERBS data tapes generated by Goddard during spacecraft passes and 
convert the data into an HP-1000 compatible format for data 
analysis . 
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I 


2 ♦FILES'C 1,1) 

3 PROGRAM PCM 

4 C 


5 

6 
7 
3 
9 

1 0 
1 1 
12 

13 

14 

15 

16 
17 
19 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 
33 

39 

40 

41 

42 

43 

44 

45 

46 

47 
43 

49 

50 

51 

52 

53 

54 

55 

56 


C 

C 

C 

C 

C 

C 

C 

C 

C 


2000 


1 000 


1 001 


1 002 


1 003 


1 004 


1 005 


1 006 


1 007 


1 008 


1 030 


1 031 


PCM IS A FORMAT CONVERSION PROGRAM. IT IS DESIGNED TO 
READ ERBS DATA TAPES GENERATED BY GODDARD DURING 
SPACE CRAFT PASSES AND CONVERT THE DATA INTO AN HP-1000 
COMPATABLE FORMAT FOR DATA ANALYSIS . 


DIMENSION IBUF< 1 700 >, NBUFC 1 508 ), LBUF< 1700), IMF< 10) 

INTEGERS I SECS 
EQUIVALENCE < ISECS, NBUF< 37 ) ) 

COMMON/MSK/MSKR< 1 6 ), MSKLC 1 6 > 

DATA LUIN, LUQUT/9, 8/ 

DATA IMF/2 , 1 1 ,21 , 30, 39, 51 , 60, 70, 80, 89/ 

DATA L 1 2, LI 6/1 2, 16/ 

LUT=LQGLU< IDUM ) 

CALL LGBUF< LBUF, 1700) 

URITE< LUT,20Q0) 

FORMAT< " MOUNT SOURCE ON DYLON, DEST ON HP DRIVE") 

IBUF< 1 )=1 1 ! TRW RECORD TYPE 11 <PCM DATA) 

URITECLUT, 1 000) 

FORMAT< " ENTER TEST PROCEDURE <10 CHARS)” ) 

READ< LUT, 1 001 ) < IBUF< J ), J=9, 1 3 ) 

FQRMAT< 5A2 ) 

URITE<LUT, 1 002) 

FORMAT< " IS THIS TEST IN VACUUM? <Y/N)" ) 

READ< LUT, 1 003 ) IANS 
FORMATC A1 ) 

IBUF< 14)= 0 ! DEFAULT IS VACUUM 

IF< IANS.EQ. 1HN) IBUF<14)=1 ! AIR 

URITE<LUT, 1 004) 

FORMAT< “ ENTER TEST CONDUCTOR'S INITIALS <6 CHARS)") 

READ< LUT, 1 001 X IBUF< J ), J=15, 17) 

URITE<LUT, 1 005) 

FORMAT< " ENTER SCANNER SERIAL NUMBER <4 DIGITS)") 

READ< LUT, 1 001 )IBUF< 18), IBUF< 19) 

UIRITE< LUT, 1 006) 

FORMAT< " ENTER NON-SCANNER SERIAL NUMBER") 

READ< LUT, 1001 )IBUF<20>, IBUF<21 ) 

URITE< LUT, 1 007) 

FORMAT< " ENTER MAG TAPE REEL# <2 DIGITS)") 

READ< LUT, 1 008 )IBUF< 22 ) 

FORMAT< 12 ) • 

URITE<LUT, 1 030) 

FORMAT< " ENTER YEAR <4 DIGITS)") 

READ< LUT, 1 031 )IBUF< 7 ) 

FORMAT< 14) 

IBUFC23 )=1 ! INDICATES VALID DATA 

OPENCLUIN, IOSTAT=IOS, ERR=1 999 ) 

OPEN< LUOUT, IOSTAT= JOS, ERR=1 998 ) 

NMF=0 ! NEXT EXPECTED MINOR FRAME # 
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57 10- READCLUIN,ERR=98,END=25,I0STAT=I0S)NBUF 

58 GGT030 

59 25 WRITER LUT, 1 009) 

60 1 009 FORMATC" END OF INPUT TAPE, ENTER GO TO CONTINUE" , /, 

61 1” WITH ANOTHER INPUT TAPE & SAME OUTPUT TAPE",/, 

62 1" ANY OTHER RESPONSE TERMINATES PROGRAM.") 

63 READ<LUT, 1 001 MANS 

64 IF< IANS , NE . 2HG0 >G0T03999 

65 GOT0 1 0 

66 30 MF=ISHFTC IANDC NBUFC 2 ), MSKLC 8 > >, -8 > 

67 DO 100 1=1,16 

68 LPOS=8 ! FIRST SCANNER DATA IS IN UPPER BYTE 

69 1 1 00=1*1 00 + 1 ! POINTS TO BEGINNING OF OUTPUT MINOR FRAME 

70 K=13 + <1-1 >*94 ! INDEX TO BEGINNING OF SCANNER DATA 

71 IBUFC 1100)= NBUF< K-1 2 ) ! MAJOR FRAME NUMBER 

72 IBUF< 1 1 00+1 ) = ISHFT< IANDC NBUFC K-1 1 >, MSKLC 8 > >, -8 > ! MINOR FRAME # 

73 IBUFC 1 1 00+20) = I AND< NBUFC K- 1 ), MSKRC 3 ) ) ! DIG B 

74 IBUFC 1 1 00+69) = 0 ! NO ANALOG AVAILABLE FOR THIS SPOT 

75 IBUFC 1 1 00+98 )= 175363B ! SYNC WORD 

76 IBUFC 1 1 00+99 )= 4 OB ! SYNC WORD 

77 IBUFC II 00+79) = IANDC ISHFTC IAND< NBUFC K-1 ), MSKRC 8 ) ), 8 ), 

78 1 ISHFT< I AND< NBUFC K ), MSKL< 8 ) ) , -8 ) ) ! ANALOG TELEMETRY 

79 IBUFC 1 1 00+48 ) = NBUF< K+73 ) ! TIME CODE DATA 

80 IBUF< II 00+49) = NBUF< K+74 > ! TIME CODE DATA 

81 IBUFC II 00+50) = NBUFC K+75) ! TIME CODE DATA 

82 DO 90 J=1,10 ! INSTRUMENT MINOR FRAME LOOP 

83 LF=IMFC J )+1 1 00 ! START LOC IN IBUF FOR MINOR FRAME 

84 LL=LF+7 ! STOP LOC IN IBUF FOR SCANNER DATA. 

85 C IBUFCLL+1 >=IBITSC NBUFC K >, LPOS, LI 6, K > ! GET NON-SCANNER VALUE 

36 DO 80 L=LF*LL 

87 C UR I TEC 6, 21 00 )K, LPOS, NBUF< K >, NBUFC K+ 1 ) 

88 2100 FORMAT< " K, LPOS, NBUFC K ), NBUFC K+1 ) : ",215,208) 

89 . IBUF< L )= IBITS< NBUF< K ), LPOS, L12, K ) ! GET- SCANNER DATA VALUE 

90 C WRITEC 6,21 01 )L, IBUF< L ), LPOS, K 

91 2101 FORMAK" L, IBUF< L ), LPOS, K : " , 15, 08, 215, // ) 

92 80 CONTINUE 

93 C WRITE< 6, 21 02 )K, LPOS,NBUF< K ), NBUF< K+1 ) 

94 2102 FORMATC " K, LPOS, NBUF< K ), NBUF< K+1 ): " ,215,208,////) 

95 IBUFCLL+1 >= IBITSC NBUFC K ), LPOS, L 1 6, K ) GET NON-SCANNER VALUE 

96 90 CONTINUE 

! 97 100 CONTINUE 

, 98 IBUFC 6 )= IOR <I8HFT<IAND<NBUF<1 ), IB), 13), 

99 1 ISHFTC IANDC NBUFC 86), 1 77770B ), -3 ) ) ! JULIAN DAY 

1 00 NHREDS=IORC ISHFTC IANDC NBUFC 8? >, 3B >, 8 >, ISHFTC IANDC NBUFC 88 ) , 

101 1 MSKLC 8 ) ), -8 ) ) 

102 WRITEC LUT , 582 >< NBUFC LG ) , LG=86, 88 ) 

103 582 FORMATC 308 ) 

104 ISECS= ISHFTC IANDC ISECS, 777776000B >, -1 0) 

105 WRITEC LUT, 327 )NBUFC 87), NBUFC 88) 

106 327 FORMATC" ISECS = ", 208 > 

107 NHR= I SECS/36 00 ! HOURS 

108 ISECS=ISECS-NHR*3600 

109 MINS=ISECS/60 

110 NSECS=MODC ISECS, 60) 

111 IBUFC 2 )=NHREDS 
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112 
1 13 

114 

115 
1 16 

1 17 2424 

118 

119 

120 1999 

121 1 01 0 
122 

123 1998 

124 1011 

125 

126 3999 

127 

128 C 

129 

130 4999 

131 5000 

132 

133 98 

134 1012 

135 

136 


IBUF< 3 >=NSECS 
IBUF< 4 )=MINS 
IBUF< 5 )=NHR 

URITE< LUO UT, ERR =499 9, IOSTAT=JGS )IBUF 
WRITE< LUT, 2424 )< IBUF< K J >, K J=2, 7 > 

FORMAT< 615 > 

GOT0 1 0 

WRITEC LUT, 1010) 

FORMAT< " ERROR TRYING TO OPEN INPUT TAPE") 
STOP 

UIRITECLUT, 1011) 

FORMAT< " ERROR TRYING TO OPEN OUTPUT TAPE") 
STOP 

CONTINUE 
ENDFILEC LUOUT) 

ENDFILE< LUTOUT) 

STOP 

UR I TE< LUT, 500 0 ) JOS 

FORMA T< " OUTPUT ERROR ,15) 

STOP 

URITE< LUT, 1 012) 

FORMAT< " ERROR READING INPUT TAPE") 

STOP 

END 


FTN4X COMPILER: HP92834 REV. 2130 <8f0?16) 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 6187 COMMON: 


1985 


< NONE ) 
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13? FUNCTION IBITS< INP, LPOS, LEN, K) 

138 C 

139 C 

140 C 

141 C FUNCTION IBITS IS USED TO EXTRACT VALUES EITHER WITHIN DATA WORDS 

142 C OR BETWEEN OVERLAPPING DATA WORDS. 

143 C 

144 C 

145 C 

146 DIMENSION INP<2> 

147 C BITS ARE NUMBERED 1 TO 16 < RATHER THAN 0 TO )5> 

148 C0MM0N/MSK7MSKR< 16>,MSKL< 16) 

149 IF< LPOS . GT . 1 6 . OR . LPOS . LT . 1 )STOP 

150 IF< LEN . GT . 1 6 . OR . LEN . LT . 1 3STOP 

151 IF<LPOS-LEN>1 0,20,30 

152 10 ISHFL=LEN-LPOS 

153 ISHFR“1 6-LEN+LPOS 

154 IBITS=IOR< ISHFT< IAND< INP< 1 ) , MSKRC LPOS > > , I SHFL > 

155 1 , ISHFT< IAND< INP< 2 ), MSKL< LEN-LPOS ) ), - ISHFR > ) 

156 K=K+ 1 

157 LPOS=LPOS-LEN+1 6 

1 58 RETURN 


159 20 IBITS=I AND< INP< 1 ), MSKR< LEN ) ) 

160 K=K+1 

161 LPOS= 1 6 

162 RETURN 

163 30 ISHFR=LPOS“LEN 

164 IBITS=IAND< ISHFT< INP< 1 ), -ISHFR >, MSKR< LEN > > 

165 LPOS=LPGS-LEN 

166 RETURN 

167 END 


FTN4X COMPILER: HP92334 REV. 2130 <810716) 

*+ NO WARNINGS ** NO ERRORS ** PROGRAM: 129 COMMON: < NONE > 

i . 
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1 68 BLOCK DATA 

169 COMMON/MSK/‘MSKR< 16), MSKLC 1 6 ) 

170 DATA MSKR/1 ,3,7, 17B,37B,77B, 1 77B, 377B, 777B, 1777B, 

171 + 3777B, 7777B, 1 7777B, 37777B, 77777B, 1 77777B/ 

172 DATA M3KL/1 0000 OB, 14000 OB, 16000 OB, 17000 OB, 17400 OB, 

173 * 176000B, t77000B, 1 7740 OB, 177600B, 1 7770 OB , 1 7774 OB , 

174 * 1 7776 OB, 1 7777 OB, 1 77774B, 1 77776B, 1 77777B/ 

175 END 


FTN4X COMPILER: HP92834 REV. 2130 <8T0716> 

** NO WARNINGS *+ NO ERRORS ** PROGRAM: < NONE) COMMON: < NONE ) 


BLOCK COMMON MSK SIZE: 32 
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ERB 


Program ERB is designed to convert ERB data in all 
experiment format to ERB data formatted like TRW BCU tapes with 
scanner and/or non scannner major frames. Scanner, if present, 
will always be on station A. Non scanner, if present, will 
always be on station B. 
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2 $FILES< 2,2) 

3 PROGRAM ERB 

4 C PROGRAM ERBS IS DESIGNED TO CONVERT ERBS DATA IN ALL 

5 C EXPERIMENT FORMAT TO ERBS DATA FORMATTED LIKE TRU BCU 

6 C TAPES WITH SCANNER AND/OR NON SCANNER MAJOR FRAMES. 

7 C SCANNER, IF PRESENT, WILL ALWAYS BE ON STATION A. 

8 C NON SCANNER, IF PRESENT, WILL ALWAYS BE ON STATION B. 

9 C 
IOC 
1 1 C 

12 DIMENSION NAME< 3 ), NAM< 5 ) ! NAME=TEST CONDUCTOR; NAM=OUTPUT FILE 

13 DIMENSION NPUT< 2 > 

14 DIMENSION IFRAM< 12, 320 ), NFRAM< 5,320), IHEAD< 96 >, NHEAD< 40 > 

15 DIMENSION IDCB< 1 44 ), IDC< 1 44 ) 

16 COMMON/STAT/LUT, LUIN, LUQUT, IBUF< 1 0 0 >, M JF, MNF, NM JF, 

17 *NMNF, IPAK< 22,256 ), ISCAN< 3938 ), NSCAN< 1642), ICHAN<32), 

18 *NCHAN< 32 ) , LBUF< 3938 > 

19 DIMENSION NUM< 4 ) 

20 EQUIVALENCE< IHEAD< 1 ), ISCAN< 3 > ), < NHEAD< 1 ),NSCAN<3)> 

21 EQUIVALENCE< IDCB< 1 ), ISCAN< 1 ) ),< IDC< 1 ), ISCANC 145)) 

22 .C 

23 C 

24 EQUIVALENCE< IFRAM< 1 ), ISCAN< 99 > ), < NFRAM< 1 ),NSCAN<43)) 

25 COMMON /TIMS/NMSEC, NSEC , NMIN, NHR, NDAY, NYR 

26 DATA ISC,NSC/060000B, 060000B/ 

27 DATA IBOMB/1 / 

28 DATA ISTR/1 / 

29 DATA ISCF,NSCF/0, 0/ 

30 C DATA LUIN, LUOUT/8, 8/ I WHEN TAPE TO TAPE COPY, LUIN=9 AND LU0UT=8 

31 DATA IANS/1/ 

32 DATA IDIGB, NDIGB/7777B, 7777B/ ! DIGB START VALUES* SCANNER , NON-SCAN 

33 DATA NAM/'MTDFIL: j20V 

34 DATA NUM/ '2021 2223 '/ 

35 LUT=LQGLU< IDUM ) * GET LU OF OPERATOR'S TERMINAL 

36 WRITE<LUT, 1 1 00) 

37 1 1 00 FORMATS* DO YOU WANT TO COPY ALL EXP. DATA TO DISK? Y/N" > 

38 READ<LUT, 1 022)1 JK 

39 IF< I JK.EQ. 1HN)GOTO1200 

40 1 103 WRITE< LUT, 1 1 01 ) 

j 41 1101 FORMAT< " IF TAPE FILE IS LONG, YOU MAY WANT TO INSERT BLANK", 

I 42 1/," DISK CARTRIDGE TYPE G WHEN READY OR A TO ABORT") 

43 READ< LUT, 1 022)1 OK 

1 44 IF< I JK.EQ. 1HA)STOP 

45 IF< I JK.NE. 1HG)G0T01 1 03 

46 DO 1 1 04 I JK=1 ,4 

47 CALL PURGE< IDCB, IERR, NAM) 

43 1104 CONTINUE 

49 ISCAN< 1 )=1 ! INDICATES INSTRUMENT DATA TO 

50 IFILE=1 

51 C ! TRU ERBE SOFTWARE 

52 NSCAN< 1 )=1 'SAME AS ABOVE .LINE 

53 ISCAN< 2 )= 1 ! INDICATES SCANNER 

54 NSCAN< 2 )=G 1 INDICATES NON-SCANNER 

55 IHEAD< 38 )=2HSC I INDICATES SCANNER 

56 NHEAD< 17 )=2HNS 1 INDICATES NON-SCANNER 
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2 

57 


58 


59 


60 


61 


62 


63 


64 


65 


66 


67 

1 000 

68 


69 

1 001 

70 


71 

1 005 

72 


73 

1 007 

74 


75 


76 

1 002 

77 


73 


79 

1 008 

80 


81 


82 

1 003 

83 


84 


85 


86 


87 


88 


89 


90 


91 

1 004 

92 


93 

1 019 

94 

1 021 

95 


i 96 

1 022 

1 97 


98 


99 


1 00 


1 01 


1 02 


103 


1 04 

1 024 

1 05 


1 06 


107 


1 08 


1 09 

1 023 

1 1 0 


1 1 1 



ERB 


OPTS: 


LYI 
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.'SCANNER WILL ALWAYS BE STATION A 
'NON-SCANNER WILL ALWAYS BE STATION B 
•INITIALIZE MAJOR FRAME COUNTERC SCANNER ) 
•INITIALIZE MAJOR FRAME COUNTERC NON-SCANNER ) 
! VAC FLAG < SET TO ZERO) 

'VALID DATA FLAG C SET TO 1 FOR VALID) 

! VAC FLAG FOR NON-SCANNER 
l VALID DATA FLAG NON-SCANNER 


IHEAD< 39 >=2HA 
NHEAD< 1 3 )=2HB 
IHEADC 1 4 )=0 
NHEADC 7 )=0 
IHEADC 63 )=0 
IHEAD< 74 )=1 
NHEAD< 23 )=0 
NHEADC 32 )=1 
CALL INIT 
URITE< LUT, 1 000) 

FORMATC " ENTER TEST PROCEDURE FOR SCANNERC12 CHARACTERS)") 
READ< LUT , 1 001 >IHEADC 1 7 ), C IHEADC KK ), KK=25, 29 ) 

FORMATC 6A2 ) 

WRITE< LUT, 1 005) 

FORMATC " ENTER SERIAL NUMBER FOR SCANNER") 

READCLUT, 1 007 )IHEADC 6 1 ), IHEAD<62) 

FORMATC 2A2) 


WRITE< LUT, 1 002) 

FORMATC " ENTER TEST PROCEDURE FOR NON-SCANNER< 12 CHAR)") 
READ< LUT, 1 001 X NHEAD< KK ) , KK = 1 0,15) 

URITECLUT, 1 008) 

FORMAT< " ENTER SERIAL NUMBER FOR NON SCANNER") 

READC LUT, 1 007 )NHEAD< 26), NHEADC 27) 

WRITE<LUT, 1 003) 

FORMATC" ENTER INITIALS OR NAMEC6 CHARACTERS)") 

READCLUT, 1001 X NAMEC KK ), KK=1 , 3 ) 

IHEADC 49 )=NAME< 1 ) 

IHEADC 50 )=NAMEC 2 ) 

IHEADC 51 )=NAMEC3) 

NHEADC 21 )=NAMEC 1 ) 

NHEADC 22 )=NAMEC 2 ) 

NHEADC 23 )=NAMEC 3 ) 

URITECLUT, 1 004) 

FORMATC" ENTER YEAR C4 DIGITS)") 

READC LUT, * )NYR 
URITECLUT, 1 021 ) 

FORMATC" IS THIS A TAPE TO TAPE COPY CY/N)") 

READCLUT, 1 022)1 JK 
FORMATCA1 ) 

IFC I JK.EQ. 1HN)G0T01 023 
IFC I JK.NE. 1HY)G0T01 019 
LUIN=9 
OPENCLUIN) 

LU0UT=3 

OPENCLUOUT) 

URITECLUT, 1 024) 

FORMATC" MOUNT SOURCE TAPE ON DYLON TAPE UNIT 
1" MOUNT DESTINATION TAPE ON HP TAPE DRIVE" 

1” TYPE GO WHEN READY ") 

READCLUT, 1 022)1 JK 

GOT0 1 

CONTINUE 

LUIN=8 

LUOUT=1 0 
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1985 

112 


GPEN< LU1N ) 


113 


OP£N< UNIT=LUOUT , FILE=NAM, IGSTAT=IQS, ERR= 1 999 > 


1 14 


WRITE<LUT, 1997> 


115 

1997 

FORMAK " %H£J") 


1 16 


GOT0 1 


1 17 

1999 

WRITE<LUT, 1998 >IOS, NAM 


118 

1998 

FORMAK" ERROR#", 15, " TRYING TO OPEN ",5A2> 


1 19 


STOP 


120 

1 

CONTINUE 


121 


CALL INP< IOS ) 


122 


IF< IOS.NE. 0JG0T088? 


123 


IHEAD< 1 )=NMSEC 


124 


IHEAD< 2 )=NSEC 


125 


IHEADC 3 >=NMIN 


126 


IHEAD< 4 )=NHR 


127 


IHEAD< SUNDAY 


128 


IHEAD< J3)=NYR 


129 


NHEAD< 1 )=NMSEC 


130 


NHEAD< 2 )=NSEC 


131 


NHEADC 3 )=NMIN 


132 


NHEAD< 4 )=NHR 


133 


NHEAD< 5 )=NDAY 


134 


NHEAD< 6 )=NYR 


135 


CALL STUFF 


136 


CALL LGBUF< LBUF ,3938) 


137 


WRI TE< LUT, 1 996 )NHR, NMIN, NSEC , NMSEC, NDAY, NYR 


138 

1996 

FORMAK “ HR MIN SEC NMSEC DAY YEAR” , 615 ) 


139 


IRET=0 


140 

87 

WRITE< UNIT=LUOUT , ERR=88, IOSTAT=IOS ) I SCAN 


141 


IRET=1 ! IRET IS USED TO DETERMINE WHICH WRITE WAS 

142 

C 

! EXECUTED LAST WHEN AN JOSTAT-533 

OCCURRED. 

143 

86 

WRITE<UNIT=LU0UT;ERR=88, IOSTAT=IOS)NSCAN 


144 


GOTOI 


145 

38 

ENDFILEC LUOUT ) 


146 


CLOSE< LUOUT ) 


147 


IF< IOS . NE . 533 )G0T098 


148 


IFILE=IFILE+1 


149 


IF< IFILE . GT . 4 )G0T0887 


150 


NAM< 5 )=NUM< IFILE) 


151 


OPEN< UNIT=LUOUT , FILE=NAM, IOSTAT=IOS, ERR=1 999 ) 


152 


WRITE< LUT, 1 088) 


153 

1 088 

FORMAK " EXTENDING MTDFIL TO NEXT AVAILABLE DISK LU" ) 


154 


IF< IRET.EQ. 0)GOT087 


155 


G0T086 


156 

887 

ENDFILE LUOUT 


157 


ENDFILE LUOUT 


J 53 


CLOSE < LUOUT) 


159 


CLOSE< LUIN ) 


160 

1200 

WRITECLUT, 1201 ) 


161 

1201 

FORMAK " DO YOU WANT ‘TO COPY DISK TO TAPE? Y/N" ) 


162 


READCLUT, 1 022)1 JK 


163 


IF< I JK.EQ. 1HN)STOP 


164 


IF< I JK.NE. 1HY)GOTO1200 


165 


WRITE< LUT, 1202) 


166 

1202 

FORMAK " MOUNT TAPE WITH WRITE RING TYPE G TO GO< A 

TO", 
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167 


1" ABORT)") 

168 


READ<LUT, 1 022)1 JK 

169 


IF< I JK.EQ. 1HA)STOP 

170 


IF< I JK.NE, 1HG)GOTO1200 

171 


CALL OPENF< I DC, I ERR, 8 ) 

172 


IF< I ERR . GE . 0 )G0T01 491 

173 


WRITE<LUT, 1490)IERR 

174 

1490 

FORMAT< " ERROR# ", 15, "TRYING TO OPEN TAPE UNIT 

175 


STOP 

176 

1491 

DO 1492 I JK— 1 , IFILE 

177 


ICAR=1 9+1 JK 

173 


CALL OPEN< IDCB, IERR-, NAM, 0, 0, ICAR) 

179 


IF< IERR.LT. 0)GOT01499 

ISO 

1493 

CALL READF< IDCB, IERR, IBUF,3938, ILEN ) 

181 


IF< IBUF.EQ. 0)GOTO1499 

182 


IF<< IERR.LT. 0). OR. < ILEN. LE. 0))GOTO 1494 

183 


CALL WRITF< IDC, IERR, IBUF, ILEN) 

184 


GOTO 1 493 

185 

1494 

CALL CLOSE< IDCB ) 

136 

1492 

CONTINUE 

187 

1499 

CALL EXEC< 3, 8+1 00B ) 

183 


CALL EXEC< 3, 8+1 00B ) 

189 


CALL RWNDF< IDC ) 

190 


STOP 

191 

98 

WRITE< LUT, 988 )IOS 

192 

988 

FORMAT< " ERROR #",15," ON DISK FILE" ) 

193 

99 

STOP 

194 


END 


FILE” 


FTN4X COMPILER : HP92834 REV. 2130 <810716) 


** HO WARNINGS ** NO ERRORS ** PROGRAM: 1653 COMMON: 


1985 


) 


< NONE ) 
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1 95 
J 96 
t 97 
J 98 

199 

200 
20 ! 

2 02 

203 

204 
2 05 
206 
207 
203 
2 09 


SUBROUTINE SCCIDAT) 

C0MM0N/STAT7LUT, LUIN, LUOUT, IBUF< 1 00 >, M JF, MNF, NM JF, 
♦NMNF, IPAK< 22, 256 ), ISCAN< 3933 >, NSCAN< 1 642 ), ICHAN< 32 >, 
*NCHAN< 32 >, LBUF< 3938 > 

DIMENSION IFRAM< 1 2, 32 0 ), NFRAM< 5,320) 

EQUIVALENCE< IFRAM< t ) , I SCAN* 99)),<NFRAM< 1 ),NSCAN<43)) 
DATA J, K/1 ,57 
IFRAMCK, J)=IDAT 
K=K+ 1 

IFCK.LT. J 3. >RETURN 

K=5 

J=J+1 

I F< J t GT . 320 > J=1 

RETURN 

END 


FTN4X COMPILER; HP92834 REV-2130 <310716) 

** NO WARNINGS ** NO ERRORS ** PROGRAM; 46 COMMON; < NONE ) 
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.210 SUBROUTINE NS(IDAT) 

211 COMMON/ST A T/LUT, LUIN, LUOUT, IBUF< 1 00 >, M JF , MNF, NM JF, 

212 +NMNF, IPAK< 22 , 256 ) , I SCAN< 3933 > , NSCAN< 1642), ICHAN<32>, 

213 *NCHAN< 32 ), LBUF< 3933 > 

214 DIMENSION NFRAM<5,320) 

215 EQUIVALENCECNFRAM< 1 >,NSCAN<43)) 

216 DATA J/1/ 

217 NFRAM< 5, J )=IDAT 

218 J=J+1 

219 IF< J . GT . 320 )J=1 

220 RETURN 

221 END 


FTN4X COMPILER: HP92834 REV. 2130 <810716) 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 23 COMMON: 


1985 


< NONE ) 


PAGE 


222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 
233 
239 


FTM4> 
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SUBROUTINE INIT 

COMMOH/STAT/LUT ,LUIN,LUOUT, IBUF< 1 00 >, M JF, MNF, NM JF, 
+NMNF , IPAK< 22, 256 ), ISC AH< 3938 >, NSC AN< 1642), ICHAN<32), 
*NCHAN<32),LBUF<3938> 

DIMENSION IFRAM< 1 2, 320 ), NFRAM< 5,320} 

EQUIVALENCE< IFRAM< 1 >, ISCAN< 99 ) >, < NFRAM< 1 ),NSCAN<43)> 
DATA ICHAN2/1 000B7 
DO 100 1=1,320 
NNF=60000B+I-1 
IFRAM< 1 , 1 )=MNF 
NFRAM< 1 , I >=MNF 
IFRAM< 3, I )=ICHAN2 
IFRAM<4,I )=ICHAN2 
NFRAM< 3, I )=ICHAN2 
NFRAMC4, I )=ICHAN2 
100 CONTINUE 
RETURN 
END 


< COMPILER: HP92834 REV. 2130 <810716) 


NO WARNINGS ** NO ERRORS **' PROGRAM: 66 COMMON: < NONE ) 


A- 60 


t i r n 


wcu , 


ii.3 JHN 


1985 


241 SUBROUTINE INPCIOS) 

242 COMMON/STAT/LUT,LUIN,LUOUT,IBUFC100),MJF,MNF,NMJF, 

243 *NMNF, IPAKC 22, 256 ), ISCANC 3938 ) , NSCANC 1642), ICHANC32), 

244 *NCHANC32),LBUFC3938) 

245 DATA I UPR/ 1 774 0 OB/ 

246 DATA IDBUG/1/ 

247 C IFC IDBUG.EQ. 0)GOTO1 

248 C WRITEC LUT, 1 02 > 

249 C02 FORMAT< " ENTER- 1 TO START/CONTINUE DBUG PRINTOUT") 

250 C READC LUT, * )IANS 

251 C IF< IANS.NE. 1 )THEN 

252 C IDBUG=0 

253 C GOT0 1 

254 C END IF 

255 C WRI TEC 6 , 1 04) 

256 C04 FORMATC///) 

257 1 CALL STARK IOS) 

258 IF< IOS.NE. 0 )RETURN 

259 CALL TIMCIBUF) 

260 1=0 

261 2 1=1+1 

262 IPAKC 1 / I )=IBUFC 1 ) ! COMMON AREA #1 

263 IPAKC 2, I )=IBUFC 2 ) J 

264 IPAKC3, I )=IBUFC3) ! 

265 IPAKC4, I )=IBITS< IBUFC 13)*8, 16) ! NON SCANNER DIG A 

266 IPAKC5, I >=IBITSC IBUFC 14>,8, 12) ! SCANNER DIG A 

267 IPAKC 6/ I )=IBITSC IBUFC 15), 12, 12) ! SCANNER DIG A 

268 IPAKC7, I)=IBITSCIBUFC34),8, 12) ! SCANNER DIG A 

269 IPAKC 8, I )=IBITS-C IBUFC35), 12, 12) ! SCANNER DIG A 

270 IPAKC 9, I )=IBITSC IBUFC 40 ), 8, 8 ) ! SCANNER & NON SC. DIG B 

271 IPAKC 1 0, 1 )=IBUFC51 ) ! COMMON #2 

272 IPAKC 11/1 )=IBUFC52) ! COMMON #2 

273 IPAK< 12, I )=IBUF<53) ! COMMON #2 

274 IPAKC 13, I )=IBITS< IBUFC59),8, 12) ! SCANNER DIG A 

275 IPAK< 14, I )=IBITSC IBUFC60), 12, 12) ! SCANNER DIG A 

276 IPAK-C 15, I )=IBUF<62) ! NON SC. DIG A < STARTS MNF# 3, THEN EVERY 4TH ) 

277 IPAKC 16, I )=IBITSC IBUF<74),8, 12) ! SCANNER DIG A 

278 IPAKC 17, I )=IBITSC IBUFC75), 12, 12) ! SCANNER DIG A 

279 IPAKC 18, I )=IBITSC IBUF<77), 16,8) ! SCANNER ANALOG TELE. 

280 IPAKC 19, I )=IBITSC IBUF< 77 ), 8, 8 ) ! SC 8, NON-SC ANALOG TEL . 

281 IPAKC20, I )=IBITSC IBUFC78), 16,8) ! SC & NON SC DIG B 

£82 IPAKC 21 , I )=IBITS< IBUFC98), 16, 12) ! SCANNER DIG A 

283 IPAKC 22,1 )=IBITSC IBUFC 98 ), 4, 12) ! SCANNER DIG A 

£84 C IFC IDBUG.EQ. 1 )URITEC6, 1 03 )C J, IPAKC J, I ), J=t ,27) 

.85 C 03 FORMATC 15,07) 

'86 IFC I . EQ . 256 )RETURN 

87 C READC LUIN, ERR=98, END=99, IOSTAT=IOS )IBUF 

38 CALL READITC IOS > 

89 IFC IOS.NE. 0)RETURN 

90 MJ=ISHFTC IANDC IBUFC 1 ),IUPR),-8) 

91 IFC M J . NE . NM JF )THEN 

92 WRITECLUT, 1 Q0)NMJF,MJ 

93 100 FORMATC" EXPECTING MAJOR- FRAME#" ,15, " BUT FOUND #",I5) 

94 GOTOI 

95 ENDIF 
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296. 

29? 

29S 

299 t 01 

300 

301 

302 
3 03 
304 
3 05 
306 
30? 

308 

309 

310 
31 1 


MNF=ISHFT< IAND< IBUF<2>, IUPR>,-8> 

IF< NMHF . NE . MNF )THEN 
WRITE< LUT, 1 01 >NMNF, MNF 
FORMAT*" EXPECTING MINOR FRAME# ",15," BUT FOUND # ", 
GOTO 1 
ENDIF 

NMNF=NMNF+1 
IF< NMNF . GT . 3 1 )THEN 
NMNF=0 
M0F=MU+t 
NM JF=NM JF+1 
I F< NMUF . GT . 255 >NM JF=0 
IF< M JF . GT . 255 >M JF=0 
ENDIF 
G0T02 
END 


r TN4X COMPILER: HP92834 REV. 2130 <810716) 


**INP *+WARNING 68 DETECTED AT LINE 311 
READIT SHORTENED TO READT 
+* 1 WARNING ** NO ERRORS ** PROGRAM: 410 COMMON: 
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15 > 


* HONE > 
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312 SUBROUTINE TIM< I6UF) 

313 DIMENSION IBUFC100) 

314 COMMON /TIMS/ NMSEC, NSEC, NMIN , HHR, NDAY, NYR 

315 NDAY=ISHFT< IAND<IBUF< 1 ), 1 ), 13) ! GET MSB OF DAY 

316 NDAY= IORCNDAY, ISHFT< IAND< IBUF<51 ), 1 7777 OB ) , -3 ) ) 

317 NDAY=NDAY-5699 

318 SEC=FLOAT< IAND< IBUF< 51 ), 7B ) ) 

319 SEC=SEC*16384+FL0AT< ISHFT< I AND< IBUF<52), 1 77774B ) , -2 ) ) 

320 MILSEC=IORCISHFT< IAND< IBUF< 52 )*3B ), 8 ), ISHFT1 IAND< IBUFC53), 

321 + 177400B),-8)) 

322 NMSEC=MILSEC/1 00 

323 NHR=INT< SEC/3600 . ) 

324 NMIN=INT< SEC/60. )-NHR*60 

325 NSEC=INT< AMQD< SEC, 60 , )) 

326 RETURN 

327 END 


r TN4X COMPILER; HP92834 REV. 2130 <810716) 


** NO WARNINGS *+ NO ERRORS ** PROGRAM : 118 COMMON; < NONE ) 
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328 SUBROUTINE STARK IOS) 

329 COMMON/'STAT/'LUT, LUIN, LUOUT, IBUF< 1 00),MJF,MNF,NMJF, 

330 +NNNF, IPAK< 22, 256 ), ISCAN< 3938 ), NSCAN< 16425, ICHANC32), 

331 *NCHAN< 32 ), LBUF< 3938 ) 

332 DATA IUPR, ILWR/1 77400B, 377B7 

333 DATA MAJ /3B7 

334 NMNF=1 

335 Cl READ<LUIN,ERR=98,END=99,IGSTAT=I0S)IBUF 

336 1 CALL READ I T< I OS > 

337 IF< IOS.NE. 0 )RETURN 

338 MJF=ISHFT< IAND< IBUF< 1 ), IUPR ), -8 ) 

339 IFLG=IAND<MJF,MAJ> 

340 IF< IFLG.NE. 0>GOTO1 

341 NM JF=M JF 

342 2 MNF=ISHFT< IAND< IBUF< 2 ), IUPR >, -8 ) 

343 IF<MNF.EQ. 0 )RETURN 

344 C READ< LUIN, ERR=98, END=99, IOSTAT=IGS)IBUF 

345 CALL READIK IQS > 

346 IF< IOS.NE. 0 )RETURN 

347 IFLG=ISHFT< IAND< IBUF< 1 >, IUPR), -3) 

348 IF< IFLG . NE . M JF >G0T01 

349 G0T02 

350 END 


-TN4X COMPILER: HP92834 REV. 2130 <810716) 

**START ++UARNING 68 DETECTED AT LINE 350 
READIT SHORTENED TO READT 

** 1 WARNING *# NO ERRORS ** PROGRAM: 59 COMMON: < NONE ) 
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351 

352 

353 

354 

355 

356 

357 
353 

359 

360 

361 

362 

363 

364 

365 

366 1 0 

367 
363 

369 

370 93 

371 101 

372 

373 99 

374 1 02 

375 

376 
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SUBROUTINE READIKIOS? 

CGMMGN/STAT/LUT , LUIN, LUOUT, IBUF< 1 GO ?, M JF, MNF, NM JF, 
*NNNF, IPAK< 22, 256 ?, ISCAN< 3938?, NSC AN < 1642?, ICHAN<32?, 
*NCHAN< 32 ? , LBUF< 3938 ? 

DIMENSION KBUF< 80 0 ?, MBUFC 80 0 ? 

EQUI VALENCECKBUF< 1 ?,LBUF< 1 ??,<MBUF< 1 ?,LBUF<801 5? 
DATA M/1/ 

CALL LGBUF< MBUF, 800 > 

IF< M . EQ . 1 ?READ< LUIN , ERR =98, END=99 , I OSTAT= I OS ?KBUF 

ISTART=<M-1 ?*1 00+1 

IST0P=ISTART+99 

J=0 

DO 10 I=ISTART, ISTOP 
J=J+1 

I BUF< J ?=LBUF< I ? 

CONTINUE 
M=M+ 1 

IF< M . GT . 8 ?M=1 
RETURN 

URITE< LUT, 101 )IGS 

FORMAT< " ERROR# ",15," READING TAPE"? 

RETURN 

WRITE< LUT, 102? 

FORMAT< " EOF ON TAPE"? 

RETURN 

END 


FTH4X COMPILER: HP92834 REV. 21 30 <810716? 

**READIT**UARNING 68 DETECTED AT LINE 376 
READ IT SHORTENED TO READT 

** 1 WARNING ** NO ERRORS ** PROGRAM: 132 COMMON: 



1 985 


< NONE ? 
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377 BLOCK DATA 

378. C0MM0N/STAT7LUT, LUIN, LUOUT, IBUF< 100), M JF, MNF, NM JF, 

379 *NMNF, IPAK< 22, 256 > , ISCAN< 3938 > , NSCAN< 1642), ICHAN<32), 

330 *NCHAN< 32 ), LBUF< 3938 > 

381 COMMON/TIMS/NMSEC, NSEC, NMIN , NHR , NDA Y, NYR 

382 DATA ICHAN/O, 7000B, 1 3+1 OOOB, 2000B, 7400B, 1400B, 1 OOOB, 400e, 

333 *1 00 OB, 240 OB, 1 00 OB, 4 0OOB,34O0B, 300 OB, 3+1 00 OB, 6 00 OB, 1 00 OB, 

384 +6400BP 

385 DATA NCHAN/8+1 OOOB, 7400B, 1 40 OB, 1 00 OB, 7000B, 1 OOOB, 240 OB, 1 OOOB, 

386 *4 00 OB, 340 OB, 300 OB, 1 OOOB, 0, 400B, 600 OB, 1 OOOB, 640 OB, 8*1 OOOB/ 

387 DATA LUIN, LUOUT/8, 9/ 

388 END 


FTH4X COMPILER: HP92834 REV. 2130 <810716) 

** NO WARNINGS +* HO ERRORS ** PROGRAM: < NONE > COMMON: < NONE ) 

BLOCK COMMON TIMS SIZE: 6 

BLOCK COMMON STAT SIZE: 15321 
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339 SUBROUTINE STUFF 

390 COMMGN/STAT/LUT, LUIN, LUOUT, IBUF< 1 0 0 >, M JF , MNF , NM JF, 

391 +NMNF , IPAK< 22, 256 ), ISCAN< 3938 ), NSCAN< 16*42), ICHAH<32), 

392 *NCHAN< 32),LBUF<3938) 

393 DIMENSION IFRAM< 1 2, 320 ), NFRAM< 5, 320 > 

394 EQUI VALENCE< IFRAM< 1 ), ISCAN< 99 >), < NFRAM< 1 ),NSCAN<43) > 

395 DATA ID IGB , ND IGB/2*7777B? 

396 DO 1 00 1=1,256 

39? CALL NS< IPAK< 4,1)) 

398 CALL SC< IPAKC5, I )) 

399 CALL SC< IPAK<6, I )) 

400 CALL SCC IPAK< 7,1)) 

401 CALL SC< IPAK< 8,1)) 

402 CALL SC< IPAK< 13, I )) 

403 CALL SC< IPAKC 14, I >) 

404 CALL SC< IPAKC 16, I )) 

405 CALL SC< IPAK< 17, I >) 

406 CALL SC< IPAK< 21,1)) 

407 CALL SC< IPAKC22, I )) 

403 IF<MOD< I , 4 ) . EQ . 0 )CALL NS< IPAK< 15,1)) 

409 MH=MOD< 1-1 ,32 )+1 

410 J=I / . 3 

411 K= 1 8 

412 IF< MN . LT . 3 )K=1 9 

413 IF< ICHAN< MN ) . NE . 1 00 OB )IFRAM< 3, J )=IPAK< K, I )+ICHAN(MN> 

414 IF< NCHAN< MN ) . NE . 1 000B )NFRAM< 3, J )=IPAK< 19,1 )+NCHAN< MN > 

415 100 CONTINUE 

416 C 
41? C 

418 C 

419 DO 200 1=1,320 

420 J=I*.8 

421 J=MOD< J, 32 ) 

422 IF< J . EQ . 26 )CALL DIGB< IDIGB, NDIGB, IPAK< 9,25>,IPAK< 9,26), 

423 *IPAK< 9,27)) 

424 IFRAMC2, I )=IDIGB 

.425 NFRAMC2, I )=NDIGB 

426 200 CONTINUE 

427 RETURN 

423 END 

i 

« 


-TN4X COMPILER: HP92834 REV. 21 30 <810716) 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 264 COMMON: < NONE ) 
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429 

430 

431 

432 

433 

434 

435 

436 

437 
433 


SUBROUTINE DIGB< IBIGB, NDIGB, 134,135, 136) 

DATA L34, L35, L36/3* 1 77777B7 

IF< I34.NE.L34) CALL S34< IDIGB, 134 ) 

IF< I35.NE.L35) CALL S35< IDI GB , ND IGB , 135 > 

IF< I36.NE.L36) CALL S36< NDIGB , 136 > 

L34=I34 

L35=I35 

L36=I3o 

RETURN 

END 


•TN4X COMPILER: HP92834 REV. 21 30 <310716) 


** NO WARNINGS +* NO ERRORS ** PROGRAM: 41 COMMON: 



i 985 


< NONE ) 
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439 BLOCK DATA 

44 0 CQMMON/B ITS/IB I T< 8 >, NPOS< 8 > , IPOS< 8 >, JPOS< 4 > 

441 DATA IBIT/1 ,2,4,8,.16,32,64, 123/ 

442 DATA IPOS/7, 4,3,2,1,5,10,0/ 

443 DATA HPOS/7, 4 , 3 , 2 , 1 , 5 , 1 0 , 0/ 

444 DATA JPOS/8,9, 8,9 / 

445 END 


FTN4X COMPILER; HP92834 REV. 21 30 <810716) 


** HO WARNINGS ** NO ERRORS ** PROGRAM: < NONE ) COMMON: 


BLOCK COMMON BITS SIZE: 28 


1985 


< NONE ) 
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446 SUBROUTINE S34< IDIGB, 134) 

447 COMMON/B ITS/IB I T< 8 ), NPOS< 8 ), IP0S<8>, JPOS < 4 > 

443 DO 10 1=1,8 

449 IB=IAND< IBIT< I >,134) 

450 J=IPOS<I> 

451 IDIGB=IPOKE< IDIGB, J, IB> 

452 10 CONTINUE 

453 RETURN 

454 END 


FTN4X COMPILER! HP92834 REV. 2130 <810716> 

** NO WARNINGS *+ NO ERRORS *+ PROGRAM: 36 COMMON: < NONE > 
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455 

456 

457 
453 

459 

460 

461 

462 

463 

464 

465 

466 

467 

468 

469 

470 


SUBROUTINE S35< IDIGB, NDIGB, 135 ) 
COMMON/BITS/IB IT< 8 ), NPOSC 8),IP0S<8), JPOS< 4 ) 
IB=IAND< IBIT< 7 ), 135) 

J=JPOS< 1 ) 

IDIGB=IPOKE< IDIGB, J,IB) 

IB=IAND< IBIT<8), 135) 

J=JP0S<2) 

IDIGB=IPOKE< IDIGB, J, IB) 

IB=IAND< IBIT<5), 135) 

J= JPOS< 3 ) 

NDIGB=IPOKE< NDIGB, J, IB ) 

IB=IAND< IBIT<6>, 135) 

J= JPOS< 4 ) 

HDIGB=IPOKE<NDIGB, J, IB) 

RETURN 

END 


FTN4X COMPILER: HP92834 REV . 21 30 < 31 071 6 > 

** NO WARNINGS ** NO ERRORS ** PROGRAM: 54 COMMON: 


< NONE ) 
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471 

472 

473 

474 

475 

476 

477 1 0 

478 

479 


SUBROUTINE S36< NDIGB, 136 ) 

COMMON/BITS7IBIT< 8 ), NPOS< 8 ), IPOS< 8 ), JP0S<4> 
DO 10 1-1,8 
IB=IAND< IBIT< I ), 136) 

J=NPOS< I ) 

NDIGB=IPOKE< NDIGB. J, IB) 

CONTINUE 

RETURN 

END 


FTN4X COMPILER: HP92834 REV. 2130 <810716) 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 36 COMMON: 


t985 


< NONE > 
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480 

48 1 

482 

483 

484 

485 

486 1 0 

487 
483 

489 

490 • 

491 20 

492 

493 30 

494 

495 

496 
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FUNCTION IBITS< INP, LRQS, LEN ) 

DIMENSION INP< 2 ) 

COMMON/MSK/MSKR< 16),MSKL< 16) 

• IF< LPOS.GT. 16.0R.LP0S.LT. 1 )STOP 
IF< LEN. GT. 16.0R.LEN.LT. 1 )STQP 
IF< LPOS-LEN >1 0,20,30 
ISHFL=LEN-LPOS 
ISHFR= 1 6-LEN+LPOS 

IBITS=ISHFT< IAND< INP< 1 ), MSKR< LPOS > ), ISHFL) 

1 .OR. ISHFT< IAND< INP< 2 >, MSKL< LEN-LPOS > >, -ISHFR > 
RETURN 

IBITS=IAND< INPCI ),MSKR<LEN>> 

RETURN 

ISHFR=LPOS-LEN 

IBITS=IAND< ISHFT< INP< 1 >, -ISHFR >, MSKR< LEN ) ) 

RETURN 

END 


FTN4X COMPILER; HP92834 REV. 2130 <810716) 

+* NO WARNINGS ** NO ERRORS ** PROGRAM; 11J COMMON; 



< NONE ) 


A- 7 3 


PAGE 


4:24 PM WED., 


JAN . , i 985 


497 

493 

499 

500 

501 

502 

503 

504 


BLOCK DATA 

COMMON/MSK/MSKR< 1 6 >, MSKL< 1 6 ) 

DATA MSKR/1 ,3,7, 1 7B, 37B, 77B, 177B,377B,777B, 1777B, 

+ 37.77B, 7777B, 1 7777B, 37777B, 77777B, 177777B/ 

DATA MSKL71 00 00 OB, 1 4 0000B, 160 0 0 OB, 17000 OB, 17400 OB, 

* 176 00 OB, 17700 OB, 177400B, 1776008, 177700B, 177740B, 

* 1 7776 OB, 1 7777 OB, 177774B, 177776B, 177777B/ 

END 


FTN4X COMPILER: HP92834 REV. 2130 <8t0716> 

** NO WARNINGS ** NO ERRORS ** PROGRAM: (NONE) COMMON: (NONE) 

BLOCK COMMON MSK SIZE: 32 
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LYI 


505 

506 C 

507 C 

508 C 

509 C 

510 C 

511 C 

512 

513 

514 

515 

516 

517 

518 

519 

520 

521 

522 

523 

524 

525 

526 


FUNCTION IPOKE< IWORD, MBIT, IBIT) 

THIS FUNCTION WILL RETURN A ZERO OR ONE < ACCORDING TO THE VALUE 
OF IBIT) IN THE UORD IPOKE AT BIT POSITION NBIT . 

NBIT CAN BE ANY NUMBER FROM 0 TO 15. IBIT CAN BE 0 <ZERO) OR 
NON ZERO. A ZERO (JILL CAUSE ONE BIT OF IWORD TO BE SET TO ZERO. 

A NON ZERO VALUE WILL CAUSE ONE BIT OF IWORD TO BE SET TO ONE. 

DATA MM, NN, JJ/177777B, 077777B, 1 00000B/ 

IF< NBIT . EQ . 1 5 >THEN 

MAS=NN ! IF NBIT IS 15, SELECT MASK 'NN' 

ELSE 

MAS=MM-2**NBIT 1 OTHERWISE, CONSTRUCT A MASK 
ENDIF 

IPOKE=IAND< IWORD, MAS) 'GRAB ALL THE BITS EXCEPT THE ONE MASKED OFF 
IF< IBIT.EQ. ORETURN ! IF IBIT IS ZERO, THE JOB IS DONE. 

IF<NBIT.EQ. 15)THEN 

IPOKE=IOR< IPOKE, JJ) I IF REPLACING 15TH BIT, USE MASK 'JJ' 

ELSE 

IPGKE=I0R< IPOKE, 2**NBIT ) 10THERWISE 'OR' IN THE BIT. 

ENDIF 

RETURN 

END 


FTN4X COMPILER: HP92834 REV.2130 <810716) 


*+ NO WARNINGS ** NO ERRORS ** PROGRAM: 50 COMMON: < NONE ) 
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